Implemented @@inject

src/annotation_processor/implementation/yaml-transformator-annotation-concatenation.adb

@@ -38,10 +38,16 @@ package body Yaml.Transformator.Annotation.Concatenation is
    end Next;
 
    function New_Concatenation (Pool : Text.Pool.Reference;
-                               Context : Events.Context.Reference)
+                               Node_Context : Node_Context_Type;
+                               Processor_Context : Events.Context.Reference;
+                               Swallows_Previous : out Boolean)
                                return not null Pointer is
-     (new Instance'(Transformator.Instance with Pool => Pool,
-                    Context => Context, others => <>));
+      pragma Unreferenced (Node_Context);
+   begin
+      Swallows_Previous := False;
+      return new Instance'(Transformator.Instance with Pool => Pool,
+                           Context => Processor_Context, others => <>);
+   end New_Concatenation;
 
    procedure Initial (Object : in out Instance'Class; E : Event) is
    begin

src/annotation_processor/implementation/yaml-transformator-annotation-concatenation.ads

@@ -14,7 +14,9 @@ package Yaml.Transformator.Annotation.Concatenation is
    overriding function Next (Object : in out Instance) return Event;
 
    function New_Concatenation (Pool : Text.Pool.Reference;
-                               Context : Events.Context.Reference)
+                               Node_Context : Node_Context_Type;
+                               Processor_Context : Events.Context.Reference;
+                               Swallows_Previous : out Boolean)
                                return not null Pointer;
 private
    type State_Type is not null access procedure (Object : in out Instance'Class;

src/annotation_processor/implementation/yaml-transformator-annotation-for_loop.adb

@@ -57,6 +57,7 @@ package body Yaml.Transformator.Annotation.For_Loop is
                   if Object.Loop_Variable_Store.Value.Element
                     (Object.Loop_Variable_Target).Kind = Sequence_End then
                      Object.Emitting_State := Emit_Sequence_End;
+                     return;
                   else
                      Object.Start_Next_Loop_Iteration;
                      return;
@@ -75,16 +76,25 @@ package body Yaml.Transformator.Annotation.For_Loop is
    end Next;
 
    function New_For_Loop (Pool : Text.Pool.Reference;
-                          Context : Events.Context.Reference)
+                          Node_Context : Node_Context_Type;
+                          Processor_Context : Events.Context.Reference;
+                          Swallows_Previous : out Boolean)
                           return not null Pointer is
-     (new Instance'(Ada.Finalization.Limited_Controlled with
-                    Context => Context, Node_Properties => <>,
-                    State => Initial'Access, Depth => 0, Body_Store => <>,
-                    Loop_Variable => <>, Loop_Variable_Store => <>,
-                    Loop_Variable_Target => <>, Body_Start => <>,
-                    Emitting_State => Emit_Sequence_Start, Next_Event => <>,
-                    Header_Locals => Events.Context.No_Local_Store,
-                    Body_Locals => Events.Context.No_Local_Store));
+      pragma Unreferenced (Pool);
+      pragma Unreferenced (Node_Context);
+   begin
+      Swallows_Previous := False;
+      return new Instance'(Ada.Finalization.Limited_Controlled with
+                             Context => Processor_Context,
+                           Node_Properties => <>, State => Initial'Access,
+                           Depth => 0, Body_Store => <>, Loop_Variable => <>,
+                           Loop_Variable_Store => <>,
+                           Loop_Variable_Target => <>, Body_Start => <>,
+                           Emitting_State => Emit_Sequence_Start,
+                           Next_Event => <>,
+                           Header_Locals => Events.Context.No_Local_Store,
+                           Body_Locals => Events.Context.No_Local_Store);
+   end New_For_Loop;
 
    procedure Initial (Object : in out Instance; E : Event) is
    begin

src/annotation_processor/implementation/yaml-transformator-annotation-for_loop.ads

@@ -13,7 +13,9 @@ package Yaml.Transformator.Annotation.For_Loop is
    overriding function Next (Object : in out Instance) return Event;
 
    function New_For_Loop (Pool : Text.Pool.Reference;
-                          Context : Events.Context.Reference)
+                          Node_Context : Node_Context_Type;
+                          Processor_Context : Events.Context.Reference;
+                          Swallows_Previous : out Boolean)
                           return not null Pointer;
 private
    type State_Type is not null access procedure (Object : in out Instance;

src/annotation_processor/implementation/yaml-transformator-annotation-inject.adb

@@ -0,0 +1,171 @@
+--  part of AdaYaml, (c) 2017 Felix Krause
+--  released under the terms of the MIT license, see the file "copying.txt"
+
+package body Yaml.Transformator.Annotation.Inject is
+   procedure Put (Object : in out Instance; E : Event) is
+   begin
+      Object.State.all (Object, E);
+   end Put;
+
+   function Has_Next (Object : Instance) return Boolean is
+     (Object.Current_Exists);
+
+   overriding function Next (Object : in out Instance) return Event is
+   begin
+      return Ret : constant Event := Object.Current do
+         if Object.State = Injecting'Access then
+            Object.Current_Exists := False;
+         elsif Object.State = Injecting_Aliased'Access then
+            Object.Injecting (Object.Current_Aliased.Value.Next);
+         else
+            raise Constraint_Error with "no event available";
+         end if;
+      end return;
+   end Next;
+
+   function New_Inject (Pool : Text.Pool.Reference;
+                        Node_Context : Node_Context_Type;
+                        Processor_Context : Events.Context.Reference;
+                        Swallows_Previous : out Boolean)
+                        return not null Pointer is
+      pragma Unreferenced (Pool);
+   begin
+      case Node_Context is
+         when Document_Root =>
+            raise Annotation_Error with "@@inject: cannot inject at root node";
+         when Mapping_Key =>
+            raise Annotation_Error with
+              "@@inject: cannot inject at mapping key; use empty key and inject at value instead";
+         when Mapping_Value =>
+            Swallows_Previous := True;
+            return new Instance'(Ada.Finalization.Limited_Controlled with
+                                 Context => Processor_Context, Depth => <>,
+                                 Injecting_Mapping => True,
+                                 Current_Exists => False,
+                                 State => Initial'Access,
+                                 Current_Aliased => <>, Current => <>);
+         when Sequence_Item | Parameter_Item =>
+            Swallows_Previous := False;
+            return new Instance'(Ada.Finalization.Limited_Controlled with
+                                 Context => Processor_Context, Depth => <>,
+                                 Injecting_Mapping => False,
+                                 Current_Exists => False,
+                                 State => Initial'Access,
+                                 Current_Aliased => <>, Current => <>);
+      end case;
+   end New_Inject;
+
+   procedure Initial (Object : in out Instance; E : Event) is
+   begin
+      if E.Kind /= Annotation_Start then
+         raise Stream_Error with
+           "unexpected token (expected annotation start): " & E.Kind'Img;
+      end if;
+      Object.State := After_Annotation_Start'Access;
+   end Initial;
+
+   procedure After_Annotation_Start (Object : in out Instance; E : Event) is
+   begin
+      if E.Kind /= Annotation_End then
+         raise Annotation_Error with
+           "@@inject does not take any parameters";
+      end if;
+      Object.State := After_Annotation_End'Access;
+   end After_Annotation_Start;
+
+   procedure After_Annotation_End (Object : in out Instance; E : Event) is
+   begin
+      Object.Depth := 1;
+      case E.Kind is
+         when Sequence_Start =>
+            if Object.Injecting_Mapping then
+               raise Annotation_Error with
+                 "trying to inject a sequence into a mapping";
+            end if;
+         when Mapping_Start =>
+            if not Object.Injecting_Mapping then
+               raise Annotation_Error with
+                 "trying to inject a mapping into a sequence";
+            end if;
+         when Alias =>
+            declare
+               use type Events.Context.Cursor;
+               use type Text.Reference;
+               Position : constant Events.Context.Cursor :=
+                 Events.Context.Position (Object.Context, E.Target);
+            begin
+               if Position = Events.Context.No_Element then
+                  raise Annotation_Error with "Unresolvable alias: *" &
+                    E.Target;
+               end if;
+               declare
+                  Stream : constant Events.Store.Stream_Reference :=
+                    Events.Context.Retrieve (Position);
+                  Referred : constant Event := Stream.Value.Next;
+               begin
+                  case Referred.Kind is
+                     when Sequence_Start =>
+                        if Object.Injecting_Mapping then
+                           raise Annotation_Error with
+                             "trying to inject a sequence into a mapping";
+                        end if;
+                     when Mapping_Start =>
+                        if not Object.Injecting_Mapping then
+                           raise Annotation_Error with
+                             "trying to inject a mapping into a sequence";
+                        end if;
+                     when others =>
+                        raise Annotation_Error with
+                          "@@inject does not support this node type";
+                  end case;
+                  Object.Current_Aliased := Stream.Optional;
+                  Object.State := Injecting_Aliased'Access;
+                  Object.Injecting (Stream.Value.Next);
+                  return;
+               end;
+            end;
+         when others =>
+            raise Annotation_Error with
+              "@@inject does not support this node type";
+      end case;
+      Object.State := Injecting'Access;
+   end After_Annotation_End;
+
+   procedure Injecting (Object : in out Instance; E : Event) is
+   begin
+      Object.Current := E;
+      case E.Kind is
+         when Sequence_Start | Mapping_Start | Annotation_Start =>
+            Object.Depth := Object.Depth + 1;
+            return;
+         when Annotation_End =>
+            Object.Depth := Object.Depth - 1;
+            return;
+         when Sequence_End | Mapping_End =>
+            Object.Depth := Object.Depth - 1;
+         when others => null;
+      end case;
+      if Object.Depth = 0 then
+         Object.State := After_Inject_End'Access;
+      else
+         Object.Current_Exists := True;
+      end if;
+   end Injecting;
+
+   procedure Injecting_Aliased (Object : in out Instance; E : Event) is
+      pragma Unreferenced (Object);
+   begin
+      raise Annotation_Error with
+        "unexpected input to @@inject while injecting aliased node: " &
+        E.Kind'Img;
+   end Injecting_Aliased;
+
+   procedure After_Inject_End (Object : in out Instance; E : Event) is
+      pragma Unreferenced (Object);
+   begin
+      raise Annotation_Error with
+        "unexpected input to @@inject (already finished): " & E.Kind'Img;
+   end After_Inject_End;
+begin
+   Annotation.Map.Include ("inject", New_Inject'Access);
+end Yaml.Transformator.Annotation.Inject;

src/annotation_processor/implementation/yaml-transformator-annotation-inject.ads

@@ -0,0 +1,40 @@
+--  part of AdaYaml, (c) 2017 Felix Krause
+--  released under the terms of the MIT license, see the file "copying.txt"
+
+private with Yaml.Events.Store;
+
+package Yaml.Transformator.Annotation.Inject is
+   type Instance is limited new Transformator.Instance with private;
+
+   overriding procedure Put (Object : in out Instance; E : Event);
+
+   overriding function Has_Next (Object : Instance) return Boolean;
+
+   overriding function Next (Object : in out Instance) return Event;
+
+   function New_Inject (Pool : Text.Pool.Reference;
+                        Node_Context : Node_Context_Type;
+                        Processor_Context : Events.Context.Reference;
+                        Swallows_Previous : out Boolean)
+                        return not null Pointer;
+private
+   type State_Type is not null access procedure (Object : in out Instance;
+                                                 E : Event);
+
+   procedure Initial (Object : in out Instance; E : Event);
+   procedure After_Annotation_Start (Object : in out Instance; E : Event);
+   procedure After_Annotation_End (Object : in out Instance; E : Event);
+   procedure Injecting (Object : in out Instance; E : Event);
+   procedure Injecting_Aliased (Object : in out Instance; E : Event);
+   procedure After_Inject_End (Object : in out Instance; E : Event);
+
+   type Instance is limited new Transformator.Instance with record
+      Context : Events.Context.Reference;
+      Injecting_Mapping : Boolean;
+      Depth : Natural;
+      State : State_Type;
+      Current : Event;
+      Current_Exists : Boolean;
+      Current_Aliased : Events.Store.Optional_Stream_Reference;
+   end record;
+end Yaml.Transformator.Annotation.Inject;

src/annotation_processor/implementation/yaml-transformator-annotation-vars.adb

@@ -18,10 +18,20 @@ package body Yaml.Transformator.Annotation.Vars is
    end Next;
 
    function New_Vars (Pool : Text.Pool.Reference;
-                      Context : Events.Context.Reference)
+                      Node_Context : Node_Context_Type;
+                      Processor_Context : Events.Context.Reference;
+                      Swallows_Previous : out Boolean)
                       return not null Pointer is
-     (new Instance'(Transformator.Instance with Context => Context,
-                    others => <>));
+      pragma Unreferenced (Pool);
+   begin
+      if Node_Context /= Document_Root then
+         raise Annotation_Error with
+           "@@vars may only be applied to a document's root node";
+      end if;
+      Swallows_Previous := True;
+      return new Instance'(Transformator.Instance with
+                             Context => Processor_Context, others => <>);
+   end New_Vars;
 
    procedure Initial (Object : in out Instance; E : Event) is
    begin

src/annotation_processor/implementation/yaml-transformator-annotation-vars.ads

@@ -13,11 +13,10 @@ package Yaml.Transformator.Annotation.Vars is
 
    overriding function Next (Object : in out Instance) return Event;
 
-   overriding function Swallows_Document (Object : in out Instance)
-                                          return Boolean is (True);
-
    function New_Vars (Pool : Text.Pool.Reference;
-                      Context : Events.Context.Reference)
+                      Node_Context : Node_Context_Type;
+                      Processor_Context : Events.Context.Reference;
+                      Swallows_Previous : out Boolean)
                       return not null Pointer;
 private
    type State_Type is not null access procedure (Object : in out Instance;

src/annotation_processor/implementation/yaml-transformator-annotation.ads

@@ -7,9 +7,27 @@ with Text.Pool;
 with Yaml.Events.Context;
 
 package Yaml.Transformator.Annotation is
+   type Node_Context_Type is (Document_Root, Sequence_Item, Mapping_Key,
+                              Mapping_Value, Parameter_Item);
+
+   --  constructs an instance of an annotation transformator. parameters:
+   --    Pool: the text pool to use for creating new scalar events.
+   --    Node_Context: describes the surroundings of the annotation occurrence
+   --                  inside the event stream.
+   --    Processor_Context: current alias targets.
+   --    Swallowes_Previous: may only be True in two cases:
+   --      1. Node_Context is Document_Root. in this case, the previous
+   --         Document_Start as well as the succeeding Document_End event is
+   --         swallowed.
+   --      2. Node_Context is Mapping_Value. in this case, the previous scalar
+   --         mapping key is swallowed. if the previous mapping key was not a
+   --         scalar, an Annotation_Error will be raised by the annotation
+   --         processor.
    type Constructor is not null access
-     function (Pool : Text.Pool.Reference;
-               Context : Events.Context.Reference) return not null Pointer;
+     function (Pool : Text.Pool.Reference; Node_Context : Node_Context_Type;
+               Processor_Context : Events.Context.Reference;
+               Swallows_Previous : out Boolean)
+              return not null Pointer;
 
    package Maps is new Ada.Containers.Indefinite_Hashed_Maps
      (String, Constructor, Ada.Strings.Hash, Standard."=");

src/annotation_processor/implementation/yaml-transformator-annotation_processor.adb

@@ -9,12 +9,15 @@ with Yaml.Transformator.Annotation.Identity;
 with Yaml.Transformator.Annotation.Concatenation;
 with Yaml.Transformator.Annotation.Vars;
 with Yaml.Transformator.Annotation.For_Loop;
+with Yaml.Transformator.Annotation.Inject;
 pragma Unreferenced (Yaml.Transformator.Annotation.Concatenation);
 pragma Unreferenced (Yaml.Transformator.Annotation.Vars);
 pragma Unreferenced (Yaml.Transformator.Annotation.For_Loop);
+pragma Unreferenced (Yaml.Transformator.Annotation.Inject);
 
 package body Yaml.Transformator.Annotation_Processor is
    use type Text.Reference;
+   use type Annotation.Node_Context_Type;
 
    procedure Free_Array is new Ada.Unchecked_Deallocation
      (Node_Array, Node_Array_Pointer);
@@ -31,71 +34,149 @@ package body Yaml.Transformator.Annotation_Processor is
 
    procedure Finalize_Finished_Annotation_Impl (Object : in out Instance) is
    begin
-      if Object.Depth = Object.Annotations (Object.Count).Depth
-        and then not Object.Annotations (Object.Count).Impl.Has_Next then
-         if Object.Annotations (Object.Count).Impl.Swallows_Document then
+      if Object.Level_Count = Object.Annotations (Object.Annotation_Count).Depth
+        and then not Object.Annotations (Object.Annotation_Count).Impl.Has_Next
+      then
+         if Object.Annotations (Object.Annotation_Count).Swallows_Next then
             Object.Current_State := Swallowing_Document_End;
             Object.Current :=
               (Kind => Document_End, others => <>);
          end if;
          Free_Transformator (Object.Annotations
-                             (Object.Count).Impl);
-         Object.Count := Object.Count - 1;
+                             (Object.Annotation_Count).Impl);
+         Object.Annotation_Count := Object.Annotation_Count - 1;
       end if;
    end Finalize_Finished_Annotation_Impl;
 
-   procedure Append (Object : in out Instance; E : Event; Start : Natural) is
+   procedure Shift_Through (Object : in out Instance; Start : Natural;
+                            E : Event)
+     with Pre => Start <= Object.Annotation_Count is
+
+      Cur_Annotation : Natural := Start;
+      Cur_Event : Event := E;
    begin
-      if Object.Current_State = Existing_But_Held_Back then
-         Object.Held_Back := Object.Current;
-         Object.Current := E;
-      else
-         declare
-            Cur_Annotation : Natural := Start;
-            Cur_Event : Event := E;
-         begin
-            while Cur_Annotation > 0 loop
-               Object.Annotations (Cur_Annotation).Impl.Put (Cur_Event);
+      while Cur_Annotation > 0 loop
+         Object.Annotations (Cur_Annotation).Impl.Put (Cur_Event);
+         if Object.Annotations (Cur_Annotation).Impl.Has_Next then
+            Cur_Event := Object.Annotations (Cur_Annotation).Impl.Next;
+            if (Cur_Annotation = Object.Annotation_Count and
+                  Object.May_Finish_Transformation)
+            then
+               Finalize_Finished_Annotation_Impl (Object);
+            end if;
+            Cur_Annotation := Cur_Annotation - 1;
+         else
+            loop
+               Cur_Annotation := Cur_Annotation + 1;
+               if Cur_Annotation > Object.Annotation_Count then
+                  if Object.May_Finish_Transformation then
+                     Finalize_Finished_Annotation_Impl (Object);
+                  end if;
+                  return;
+               end if;
                if Object.Annotations (Cur_Annotation).Impl.Has_Next then
-                  Cur_Event := Object.Annotations (Cur_Annotation).Impl.Next;
-                  if (Cur_Annotation = Object.Count and
-                        E.Kind in Sequence_End | Mapping_End | Scalar | Alias)
+                  Cur_Event :=
+                    Object.Annotations (Cur_Annotation).Impl.Next;
+                  if (Cur_Annotation = Object.Annotation_Count and
+                        Object.May_Finish_Transformation)
                   then
                      Finalize_Finished_Annotation_Impl (Object);
                   end if;
                   Cur_Annotation := Cur_Annotation - 1;
-               else
-                  loop
-                     Cur_Annotation := Cur_Annotation + 1;
-                     if Cur_Annotation > Object.Count then
-                        if E.Kind /= Annotation_End then
-                           Finalize_Finished_Annotation_Impl (Object);
-                        end if;
-                        return;
-                     end if;
-                     if Object.Annotations (Cur_Annotation).Impl.Has_Next then
-                        Cur_Event :=
-                          Object.Annotations (Cur_Annotation).Impl.Next;
-                        if (Cur_Annotation = Object.Count and
-                          E.Kind in Sequence_End | Mapping_End | Scalar | Alias)
-                        then
-                           Finalize_Finished_Annotation_Impl (Object);
-                        end if;
-                        Cur_Annotation := Cur_Annotation - 1;
-                        exit;
-                     end if;
-                  end loop;
+                  exit;
                end if;
             end loop;
-            Object.Current := Cur_Event;
-            Object.Current_State := Existing;
-         end;
+         end if;
+      end loop;
+      Object.Current := Cur_Event;
+      Object.Current_State :=
+        (if Object.Current_State = Event_Held_Back then
+            Releasing_Held_Back else Existing);
+   end Shift_Through;
+
+   procedure Append (Object : in out Instance; E : Event) is
+   begin
+      if Object.Annotation_Count > 0 then
+         if Object.Current_State = Event_Held_Back then
+            Object.May_Finish_Transformation :=
+              Object.Held_Back.Kind in
+                Sequence_End | Mapping_End | Scalar | Alias;
+            if E.Kind = Annotation_Start then
+               if Object.Annotation_Count = 1 then
+                  Object.Current := Object.Held_Back;
+                  Object.Held_Back := E;
+                  Object.Current_State := Releasing_Held_Back;
+                  return;
+               else
+                  Shift_Through (Object, Object.Annotation_Count,
+                                 Object.Held_Back);
+               end if;
+            else
+               Shift_Through (Object, Object.Annotation_Count,
+                              Object.Held_Back);
+            end if;
+            if Object.Current_State = Existing then
+               Object.Held_Back := E;
+               Object.Current_State := Releasing_Held_Back;
+               return;
+            end if;
+            Object.Current_State := Absent;
+         end if;
+         Object.May_Finish_Transformation :=
+           E.Kind in Sequence_End | Mapping_End | Scalar | Alias;
+         Shift_Through (Object, Object.Annotation_Count, E);
+      elsif Object.Current_State = Event_Held_Back then
+         Object.Current := Object.Held_Back;
+         Object.Held_Back := E;
+         Object.Current_State := Releasing_Held_Back;
+      else
+         Object.Current := E;
+         Object.Current_State := Existing;
       end if;
    end Append;
 
+   generic
+      type Element_Type is private;
+      type Array_Type is array (Positive range <>) of Element_Type;
+      type Pointer_Type is access Array_Type;
+   procedure Grow (Target : in out not null Pointer_Type;
+                   Last : in out Natural);
+
+   procedure Grow (Target : in out not null Pointer_Type;
+                   Last : in out Natural) is
+      procedure Free_Array is new Ada.Unchecked_Deallocation
+        (Array_Type, Pointer_Type);
+   begin
+      if Last = Target'Last then
+         declare
+            Old_Array : Pointer_Type := Target;
+         begin
+            Target := new Array_Type (1 .. Last * 2);
+            Target (1 .. Last) := Old_Array.all;
+            Free_Array (Old_Array);
+         end;
+      end if;
+      Last := Last + 1;
+   end Grow;
+
+   procedure Grow_Levels is new Grow
+     (Annotation.Node_Context_Type, Level_Array, Level_Array_Pointer);
+
+   procedure Grow_Annotations is new Grow
+     (Annotated_Node, Node_Array, Node_Array_Pointer);
+
    procedure Put (Object : in out Instance; E : Event) is
       Locals : constant Events.Store.Accessor := Object.Context.Document_Store;
    begin
+      if Object.Level_Count > 0 then
+         case Object.Levels (Object.Level_Count) is
+            when Annotation.Mapping_Key =>
+               Object.Levels (Object.Level_Count) := Annotation.Mapping_Value;
+            when Annotation.Mapping_Value =>
+               Object.Levels (Object.Level_Count) := Annotation.Mapping_Key;
+            when others => null;
+         end case;
+      end if;
       case E.Kind is
          when Annotation_Start =>
             Locals.Memorize (E);
@@ -106,55 +187,57 @@ package body Yaml.Transformator.Annotation_Processor is
                      Annotation.Map.Find (E.Name.Value) else
                        Annotation.Maps.No_Element);
             begin
-               if Object.Count = Object.Annotations.all'Length then
-                  declare
-                     Old_Array : Node_Array_Pointer := Object.Annotations;
-                  begin
-                     Object.Annotations := new Node_Array (1 .. Object.Count * 2);
-                     Object.Annotations (1 .. Object.Count) := Old_Array.all;
-                     Free_Array (Old_Array);
-                  end;
-               end if;
-               Object.Count := Object.Count + 1;
+               Grow_Annotations (Object.Annotations, Object.Annotation_Count);
                declare
+                  Swallows_Previous : Boolean := False;
                   Impl : constant Transformator.Pointer :=
                     (if Pos = Annotation.Maps.No_Element then
                                 Annotation.Identity.New_Identity else
                                    Annotation.Maps.Element (Pos).all
-                         (Object.Pool, Object.Context));
+                         (Object.Pool, Object.Levels (Object.Level_Count),
+                          Object.Context, Swallows_Previous));
                begin
-                  Object.Annotations (Object.Count) :=
-                    (Impl => Impl, Depth => Object.Depth);
-                  Impl.Put (E);
-                  if Impl.Swallows_Document then
-                     if Object.Current_State /= Existing_But_Held_Back then
+                  Object.Annotations (Object.Annotation_Count) :=
+                    (Impl => Impl, Depth => Object.Level_Count,
+                     Swallows_Next =>
+                       Swallows_Previous and Object.Level_Count = 1);
+                  if Swallows_Previous then
+                     if Object.Current_State /= Event_Held_Back then
                         raise Annotation_Error with
                         E.Namespace & E.Name &
-                          " may only be applied on the root node of a document";
+                          " applied to a value of a non-scalar mapping key";
                      end if;
                      Object.Current_State := Absent;
-                  elsif Impl.Has_Next then
-                     Object.Append (Impl.Next, Object.Count - 1);
-                  elsif Object.Current_State = Existing_But_Held_Back then
-                     Object.Current_State := Existing;
                   end if;
+                  Object.Append (E);
                end;
             end;
+            Grow_Levels (Object.Levels, Object.Level_Count);
+            Object.Levels (Object.Level_Count) := Annotation.Parameter_Item;
          when Annotation_End =>
             Locals.Memorize (E);
-            Object.Append (E, Object.Count);
+            Object.Append (E);
+            Object.Level_Count := Object.Level_Count - 1;
          when Document_Start =>
             Locals.Clear;
-            Object.Current := E;
-            Object.Current_State := Existing_But_Held_Back;
-         when Mapping_Start | Sequence_Start =>
-            Object.Depth := Object.Depth + 1;
+            Object.Held_Back := E;
+            Object.Current_State := Event_Held_Back;
+            Grow_Levels (Object.Levels, Object.Level_Count);
+            Object.Levels (Object.Level_Count) := Annotation.Document_Root;
+         when Mapping_Start =>
             Locals.Memorize (E);
-            Object.Append (E, Object.Count);
+            Object.Append (E);
+            Grow_Levels (Object.Levels, Object.Level_Count);
+            Object.Levels (Object.Level_Count) := Annotation.Mapping_Value;
+         when Sequence_Start =>
+            Locals.Memorize (E);
+            Object.Append (E);
+            Grow_Levels (Object.Levels, Object.Level_Count);
+            Object.Levels (Object.Level_Count) := Annotation.Sequence_Item;
          when Mapping_End | Sequence_End =>
-            Object.Depth := Object.Depth - 1;
+            Object.Level_Count := Object.Level_Count - 1;
             Locals.Memorize (E);
-            Object.Append (E, Object.Count);
+            Object.Append (E);
          when Document_End =>
             if Object.Current_State = Swallowing_Document_End then
                Object.Current_State := Absent;
@@ -162,18 +245,25 @@ package body Yaml.Transformator.Annotation_Processor is
                Object.Current := E;
                Object.Current_State := Existing;
             end if;
-         when Scalar | Alias =>
+            Object.Level_Count := Object.Level_Count - 1;
+         when Scalar =>
             Locals.Memorize (E);
-            Object.Append (E, Object.Count);
-         when others =>
-            Object.Append (E, Object.Count);
+            if Object.Levels (Object.Level_Count) = Annotation.Mapping_Key then
+               Object.Held_Back := E;
+               Object.Current_State := Event_Held_Back;
+            else
+               Object.Append (E);
+            end if;
+         when Alias =>
+            Locals.Memorize (E);
+            Object.Append (E);
+         when Stream_Start | Stream_End =>
+            Object.Append (E);
       end case;
    end Put;
 
    function Has_Next (Object : Instance) return Boolean is
-     (Object.Current_State = Existing or
-        (Object.Current_State = Existing_But_Held_Back and
-             Object.Current.Kind /= Document_Start) or
+     (Object.Current_State in Existing | Releasing_Held_Back or
         (Object.Current_State = Swallowing_Document_End and
              Object.Current.Kind /= Document_End));
 
@@ -182,16 +272,37 @@ package body Yaml.Transformator.Annotation_Processor is
 
       procedure Look_For_Additional_Element is
       begin
-         if Object.Count > 0 and then
-           Object.Annotations (1).Impl.Has_Next
-         then
-            Object.Current := Object.Annotations (1).Impl.Next;
-            if Object.Count = 1 then
-               Finalize_Finished_Annotation_Impl (Object);
-            end if;
-         else
+         if Object.Current_State /= Releasing_Held_Back then
             Object.Current_State := Absent;
          end if;
+         for Cur_Annotation in 1 .. Object.Annotation_Count loop
+            if Object.Annotations (Cur_Annotation).Impl.Has_Next then
+               declare
+                  Next_Event : constant Event :=
+                    Object.Annotations (Cur_Annotation).Impl.Next;
+               begin
+                  if Cur_Annotation = Object.Annotation_Count and
+                    Object.May_Finish_Transformation then
+                     Finalize_Finished_Annotation_Impl (Object);
+                  end if;
+                  Shift_Through (Object, Cur_Annotation - 1, Next_Event);
+               end;
+               exit;
+            end if;
+         end loop;
+         if Object.Current_State = Releasing_Held_Back then
+            Object.Current_State := Absent;
+            if Object.Annotation_Count > 0 then
+               Object.May_Finish_Transformation :=
+                 Object.Held_Back.Kind in
+                   Sequence_End | Mapping_End | Scalar | Alias;
+               Shift_Through (Object, Object.Annotation_Count,
+                              Object.Held_Back);
+            else
+               Object.Current := Object.Held_Back;
+               Object.Current_State := Existing;
+            end if;
+         end if;
       end Look_For_Additional_Element;
 
       procedure Update_Exists_In_Output (Anchor : Text.Reference) is
@@ -219,9 +330,13 @@ package body Yaml.Transformator.Annotation_Processor is
       end Update_Exists_In_Output;
    begin
       case Object.Current_State is
-         when Existing =>
+         when Existing | Releasing_Held_Back =>
             case Object.Current.Kind is
                when Alias =>
+                  if Object.Current_State = Releasing_Held_Back then
+                     raise Program_Error with
+                       "internal error: alias may never generated while event is held back!";
+                  end if;
                   declare
                      Pos : Events.Context.Cursor :=
                        Events.Context.Position
@@ -258,12 +373,6 @@ package body Yaml.Transformator.Annotation_Processor is
             return Ret : constant Event := Object.Current do
                Look_For_Additional_Element;
             end return;
-         when Existing_But_Held_Back =>
-            if Object.Current.Kind = Document_Start then
-               raise Constraint_Error with "no event to retrieve";
-            end if;
-            Object.Current_State := Existing;
-            return Object.Held_Back;
          when Localizing_Alias =>
             return Ret : constant Event := Object.Current_Stream.Value.Next do
                case Ret.Kind is
@@ -286,7 +395,7 @@ package body Yaml.Transformator.Annotation_Processor is
                   Object.Current := (Kind => Document_End, others => <>);
                end return;
             end if;
-         when Absent =>
+         when Absent | Event_Held_Back =>
             raise Constraint_Error with "no event to retrieve";
       end case;
    end Next;
@@ -294,7 +403,7 @@ package body Yaml.Transformator.Annotation_Processor is
    procedure Finalize (Object : in out Instance) is
       Ptr : Node_Array_Pointer := Object.Annotations;
    begin
-      for I in 1 .. Object.Count loop
+      for I in 1 .. Object.Annotation_Count loop
          Free_Transformator (Object.Annotations (I).Impl);
       end loop;
       Free_Array (Ptr);

src/annotation_processor/interface/yaml-transformator-annotation_processor.ads

@@ -4,6 +4,7 @@
 with Text.Pool;
 with Yaml.Events.Store;
 private with Yaml.Events.Context;
+private with Yaml.Transformator.Annotation;
 
 package Yaml.Transformator.Annotation_Processor is
    type Instance (<>) is limited new Transformator.Instance with private;
@@ -13,15 +14,17 @@ package Yaml.Transformator.Annotation_Processor is
       Externals : Events.Store.Reference := Events.Store.New_Store)
       return Pointer;
 
-   overriding procedure Put (Object : in out Instance; E : Event);
+   overriding procedure Put (Object : in out Instance; E : Event)
+     with Pre => not Object.Has_Next;
 
    function Has_Next (Object : Instance) return Boolean;
 
    function Next (Object : in out Instance) return Event;
 private
-   procedure Append (Object : in out Instance; E : Event; Start : Natural);
+   procedure Append (Object : in out Instance; E : Event);
 
    type Annotated_Node is record
+      Swallows_Next : Boolean;
       Impl : Transformator.Pointer;
       Depth : Natural;
    end record;
@@ -29,18 +32,24 @@ private
    type Node_Array is array (Positive range <>) of Annotated_Node;
    type Node_Array_Pointer is access Node_Array;
 
-   type Current_State_Type is (Existing, Existing_But_Held_Back,
+   type Level_Array is array (Positive range <>) of
+     Annotation.Node_Context_Type;
+   type Level_Array_Pointer is access Level_Array;
+
+   type Current_State_Type is (Existing, Event_Held_Back, Releasing_Held_Back,
                                Swallowing_Document_End, Localizing_Alias,
                                Absent);
 
    type Instance is limited new Transformator.Instance with record
       Context : Events.Context.Reference;
       Pool : Text.Pool.Reference;
-      Depth, Count, Stream_Depth : Natural := 0;
+      Annotation_Count, Level_Count, Stream_Depth : Natural := 0;
       Current, Held_Back : Event;
       Current_State : Current_State_Type := Absent;
       Current_Stream : Events.Store.Optional_Stream_Reference;
       Annotations : not null Node_Array_Pointer := new Node_Array (1 .. 16);
+      Levels : not null Level_Array_Pointer := new Level_Array (1 .. 64);
+      May_Finish_Transformation : Boolean := False;
    end record;
 
    overriding procedure Finalize (Object : in out Instance);

src/interface/yaml-transformator.ads

@@ -12,9 +12,6 @@ package Yaml.Transformator is
    function Has_Next (Object : Instance) return Boolean is abstract;
 
    function Next (Object : in out Instance) return Event is abstract;
-
-   function Swallows_Document (Object : in out Instance) return Boolean is
-     (False);
 private
    type Instance is abstract limited new Ada.Finalization.Limited_Controlled
      with null record;

util/src/yaml-transform.adb

@@ -37,8 +37,8 @@ begin
    end if;
 
    P.Value.Set_Input (Input);
-   Trans.Append (new Transformator.Canonical.Instance);
    Trans.Append (Transformator.Annotation_Processor.New_Processor (P.Value.Pool));
+   Trans.Append (new Transformator.Canonical.Instance);
    Pres.Configure (Presenter.Default_Line_Length, Presenter.Canonical);
    Pres.Set_Output (Destination.Text_IO.As_Destination (Ada.Text_IO.Standard_Output));