Natools

Check-in [d6970f2d05]
Login
Overview
Comment:s_expressions-parsers: implement the new Lockable.Descriptor interface on Subparser objects
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d6970f2d05bb961a7e0b81d51cdc23f987b9da1d
User & Date: nat on 2014-03-05 21:22:59
Other Links: manifest | tags
Context
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
2014-03-05
21:22
s_expressions-parsers: implement the new Lockable.Descriptor interface on Subparser objects check-in: d6970f2d05 user: nat tags: trunk
2014-03-04
19:18
s_expressions-lockable: new function to help invalidate popped states check-in: 5d63dd5d69 user: nat tags: trunk
Changes

Modified src/natools-s_expressions-parsers.adb from [a9ae89461f] to [f2dfb8823e].

403
404
405
406
407
408
409
410

411
412
413
414
415
416
417
418
419
420

421
422


423
424
425
426
427
428
429
430
431
432

433
434
435
436
437
438
439
440
441
442
443
444
445

446
447
448
449
450
451
452
453
454
455
456
457
458





459

460
461
462
463
464
465
466
467
468


469
470
471
472
473
474









































475
476
477
478
479
480
481
482
483
484
403
404
405
406
407
408
409

410
411
412
413
414
415
416
417
418
419

420
421

422
423
424
425
426
427
428
429
430
431
432

433
434
435
436
437
438
439
440
441
442
443
444
445

446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464

465
466
467
468
469
470
471
472
473

474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532







-
+









-
+

-
+
+









-
+












-
+













+
+
+
+
+
-
+








-
+
+






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+










      end if;
   end Current_Event;


   function Current_Atom (P : in Subparser) return Atom is
   begin
      if P.Terminated then
         raise Constraint_Error;
         raise Program_Error;
      else
         return Current_Atom (P.Backend.all);
      end if;
   end Current_Atom;


   function Current_Level (P : in Subparser) return Natural is
   begin
      if P.Terminated then
         return P.Base_Level;
         return 0;
      else
         return Current_Level (P.Backend.all);
         return Current_Level (P.Backend.all)
           - Lockable.Current_Level (P.Levels);
      end if;
   end Current_Level;


   procedure Query_Atom
     (P : in Subparser;
      Process : not null access procedure (Data : in Atom)) is
   begin
      if P.Terminated then
         raise Constraint_Error;
         raise Program_Error;
      else
         Query_Atom (P.Backend.all, Process);
      end if;
   end Query_Atom;


   procedure Read_Atom
     (P      : in Subparser;
      Data   : out Atom;
      Length : out Count) is
   begin
      if P.Terminated then
         raise Constraint_Error;
         raise Program_Error;
      else
         Read_Atom (P.Backend.all, Data, Length);
      end if;
   end Read_Atom;


   procedure Next (P : in out Subparser; Event : out Events.Event) is
   begin
      if P.Terminated then
         raise Constraint_Error;
      end if;

      if not P.Initialized then
         declare
            Lost_State : Lockable.Lock_State;
            pragma Unreferenced (Lost_State);
         begin
            Lock (P, Lost_State);
         P.Base_Level := Current_Level (P.Backend.all);
         end;
         P.Initialized := True;
      end if;

      Next_Event (P.Backend.all, P.Input);

      Event := Current_Event (P.Backend.all);

      if Event = Events.Close_List
        and then Current_Level (P.Backend.all) < P.Base_Level
        and then Current_Level (P.Backend.all)
                   < Lockable.Current_Level (P.Levels)
      then
         P.Terminated := True;
         Event := Events.End_Of_Input;
      end if;
   end Next;


   overriding procedure Lock
     (Object : in out Subparser;
      State : out Lockable.Lock_State) is
   begin
      Lockable.Push_Level
        (Object.Levels,
         Current_Level (Object.Backend.all),
         State);
   end Lock;


   overriding procedure Unlock
     (Object : in out Subparser;
      State : in out Lockable.Lock_State;
      Finish : in Boolean := True)
   is
      Previous_Level : constant Natural
        := Lockable.Current_Level (Object.Levels);
   begin
      Lockable.Pop_Level (Object.Levels, State);
      State := Lockable.Null_State;

      if Finish then
         loop
            case Object.Backend.Current_Event is
               when Events.Open_List | Events.Add_Atom =>
                  null;
               when Events.Close_List =>
                  exit when Object.Backend.Current_Level < Previous_Level;
               when Events.Error | Events.End_Of_Input =>
                  exit;
            end case;
            Next_Event (Object.Backend.all, Object.Input);
         end loop;
      end if;

      Object.Terminated := Object.Backend.Current_Level
        < Lockable.Current_Level (Object.Levels);
   end Unlock;


   procedure Finish (P : in out Subparser) is
      Event : Events.Event := Current_Event (P);
   begin
      while Event /= Events.Error and Event /= Events.End_Of_Input loop
         Next (P, Event);
      end loop;
   end Finish;

end Natools.S_Expressions.Parsers;

Modified src/natools-s_expressions-parsers.ads from [90e8bf6ef8] to [0a7601bdad].

22
23
24
25
26
27
28

29
30
31
32
33
34
35
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36







+







-- Descriptor interface. A subparser is constrained to its initial nesting  --
-- level, and reports end-of-input instead of reaching lower.               --
------------------------------------------------------------------------------

with Ada.Streams;

with Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Lockable;

package Natools.S_Expressions.Parsers is
   pragma Preelaborate (Natools.S_Expressions.Parsers);

   type Parser is tagged private;

   function Current_Event (P : in Parser) return Events.Event;
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
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







-
+
















+
+
+
+
+
+
+
+
+
+







     (P     : in out Parser;
      Input : not null access Ada.Streams.Root_Stream_Type'Class);


   type Subparser
     (Backend : access Parser;
      Input   : access Ada.Streams.Root_Stream_Type'Class)
   is new Descriptor with private;
   is new Lockable.Descriptor with private;

   overriding function Current_Event (P : in Subparser) return Events.Event;
   overriding function Current_Atom (P : in Subparser) return Atom;
   overriding function Current_Level (P : in Subparser) return Natural;

   overriding procedure Query_Atom
     (P : in Subparser;
      Process : not null access procedure (Data : in Atom));

   overriding procedure Read_Atom
     (P      : in Subparser;
      Data   : out Atom;
      Length : out Count);

   overriding procedure Next (P : in out Subparser; Event : out Events.Event);


   overriding procedure Lock
     (Object : in out Subparser;
      State : out Lockable.Lock_State);

   overriding procedure Unlock
     (Object : in out Subparser;
      State : in out Lockable.Lock_State;
      Finish : in Boolean := True);

   procedure Finish (P : in out Subparser);
      --  Read enough data to exhaust intial nesting level

private

   type Internal_State is
     (Waiting,          --  waiting for a marker
116
117
118
119
120
121
122
123
124


125
126
127
128
129
127
128
129
130
131
132
133


134
135
136
137
138
139
140







-
-
+
+





      Buffer       : Atom_Buffers.Atom_Buffer;
      Level        : Natural := 0;
   end record;

   type Subparser
     (Backend : access Parser;
      Input   : access Ada.Streams.Root_Stream_Type'Class)
   is new Descriptor with record
      Base_Level  : Natural := 0;
   is new Lockable.Descriptor with record
      Levels      : Lockable.Lock_Stack;
      Initialized : Boolean := False;
      Terminated  : Boolean := False;
   end record;

end Natools.S_Expressions.Parsers;