Natools

Check-in [660d5d43a4]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
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: 660d5d43a435d000105540e8f5bca753ebc90080
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified src/natools-s_expressions-generic_caches.adb from [3373c2a61e] to [18facc84e2].

︙
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

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);
         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 then
      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 then
      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
      Result : Natural := 0;
      N : Node_Access := Object.Position;
   begin
      if Object.Position /= null
        and then Object.Position.Kind = List_Node
        and then Object.Opening
      if Object.Locked then
         return 0;
      else
         return Absolute_Level (Object)
           - Lockable.Current_Level (Object.Stack);
      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 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 then
      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 then
      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 then
      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
351

352




































































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;

end Natools.S_Expressions.Generic_Caches;


   -----------------------------------
   -- 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

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
55

56
57
58
59
60
61
62
63
64
65
66
67
68
69
70








71
72
73
74
75
76
77

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 Descriptor with private;
   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
134

135
136
137


138
139


140

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 Descriptor with 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;

This page was generated in about 0.005s by Fossil 2.23 [47362306a7] 2023-11-01 18:56:47