Implemented @@vars

annotation-test-suite/0008/===

@@ -0,0 +1 @@
+Concatenate Scalars From @@vars Document

annotation-test-suite/0008/in.yaml

@@ -0,0 +1,5 @@
+--- @@vars
+first: foo
+second: bar
+--- @@concat
+[*first, *second]

annotation-test-suite/0008/processed.event

@@ -0,0 +1,6 @@
++STR
++DOC ---
+=VAL :foobar
+-DOC
+-STR
+

src/implementation/yaml-events-context.adb

@@ -2,34 +2,50 @@
 --  released under the terms of the MIT license, see the file "copying.txt"
 
 package body Yaml.Events.Context is
-   function Empty return Instance is
+   function Create (External : Store.Reference := Store.New_Store)
+                    return Instance is
      ((Ada.Finalization.Controlled with
-       Local_Store => Store.New_Store, Global_Store => Store.New_Store));
+       Document_Ref => Store.New_Store, Stream_Ref => Store.New_Store,
+       External_Ref => External));
 
-   function Global (Object : Instance) return Store.Reference is
-     (Object.Global_Store);
+   function External_Store (Object : Instance) return Store.Reference is
+     (Object.External_Ref);
 
-   function Local (Object : Instance) return Store.Reference is
-     (Object.Local_Store);
+   function Stream_Store (Object : Instance) return Store.Reference is
+     (Object.Stream_Ref);
+
+   function Document_Store (Object : Instance) return Store.Reference is
+     (Object.Document_Ref);
 
    function Position (Object : Instance; Alias : Text.Reference) return Cursor
    is
       use type Store.Anchored_Position;
       Pos : Store.Anchored_Position :=
-        Object.Local_Store.Value.Position (Alias);
+        Object.Document_Ref.Value.Position (Alias);
    begin
       if Pos = Store.No_Element then
-         Pos := Object.Global_Store.Value.Position (Alias);
+         Pos := Object.Stream_Ref.Value.Position (Alias);
          if Pos = Store.No_Element then
-            return No_Element;
+            Pos := Object.External_Ref.Value.Position (Alias);
+            if Pos = Store.No_Element then
+               return No_Element;
+            else
+               return (Target => Object.External_Ref.Optional, Position => Pos,
+                       Target_Location => External);
+            end if;
          else
-            return (Target => Object.Global_Store.Optional, Position => Pos);
+            return (Target => Object.Stream_Ref.Optional, Position => Pos,
+                    Target_Location => Stream);
          end if;
       else
-         return (Target => Object.Local_Store.Optional, Position => Pos);
+         return (Target => Object.Document_Ref.Optional, Position => Pos,
+                 Target_Location => Document);
       end if;
    end Position;
 
+   function Location (Position : Cursor) return Location_Type is
+     (Position.Target_Location);
+
    function Retrieve (Pos : Cursor) return  Store.Stream_Reference is
      (Store.Iteration.Retrieve (Pos.Target.Required, Pos.Position));
 end Yaml.Events.Context;

src/implementation/yaml-events-context.ads

@@ -7,27 +7,34 @@ package Yaml.Events.Context is
    type Instance is private;
    type Cursor is private;
 
-   function Empty return Instance;
+   type Location_Type is (Document, Stream, External, None);
 
-   function Global (Object : Instance) return Store.Reference;
-   function Local (Object : Instance) return Store.Reference;
+   function Create (External : Store.Reference := Store.New_Store)
+                    return Instance;
+
+   function External_Store (Object : Instance) return Store.Reference;
+   function Stream_Store (Object : Instance) return Store.Reference;
+   function Document_Store (Object : Instance) return Store.Reference;
 
    function Position (Object : Instance; Alias : Text.Reference) return Cursor;
+   function Location (Position : Cursor) return Location_Type;
 
    No_Element : constant Cursor;
 
    function Retrieve (Pos : Cursor) return Store.Stream_Reference
      with Pre => Pos /= No_Element;
 private
    type Instance is new Ada.Finalization.Controlled with record
-      Local_Store, Global_Store : Store.Reference;
+      Document_Ref, Stream_Ref, External_Ref : Store.Reference;
    end record;
 
    type Cursor is record
       Target : Store.Optional_Reference;
       Position : Events.Store.Anchored_Position;
+      Target_Location : Location_Type;
    end record;
 
    No_Element : constant Cursor :=
-     (Target => Store.Null_Reference, Position => Events.Store.No_Element);
+     (Target => Store.Null_Reference, Position => Events.Store.No_Element,
+      Target_Location => None);
 end Yaml.Events.Context;

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

@@ -57,7 +57,7 @@ package body Yaml.Transformator.Annotation.Concatenation is
    begin
       if E.Kind /= Annotation_End then
          raise Annotation_Error with
-           "@concat does not take any parameters.";
+           "@@concat does not take any parameters.";
       end if;
       Object.State := After_Annotation_End'Access;
    end After_Annotation_Start;
@@ -66,7 +66,7 @@ package body Yaml.Transformator.Annotation.Concatenation is
    begin
       if E.Kind /= Sequence_Start then
          raise Annotation_Error with
-           "@concat must be applied on a sequence.";
+           "@@concat must be applied on a sequence.";
       end if;
       Object.State := After_List_Start'Access;
    end After_Annotation_End;
@@ -251,7 +251,7 @@ package body Yaml.Transformator.Annotation.Concatenation is
    procedure After_List_End (Object : in out Instance'Class; E : Event) is
    begin
       raise Constraint_Error with
-        "unexpected input to @concat (already finished)";
+        "unexpected input to @@concat (already finished)";
    end After_List_End;
 begin
    Map.Include ("concat", New_Concatenation'Access);

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

@@ -0,0 +1,189 @@
+--  part of AdaYaml, (c) 2017 Felix Krause
+--  released under the terms of the MIT license, see the file "copying.txt"
+
+with Yaml.Events.Context;
+
+package body Yaml.Transformator.Annotation.Vars 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 (False);
+
+   function Next (Object : in out Instance) return Event is
+   begin
+      raise Constraint_Error with "no event available";
+      return (others => <>);
+   end Next;
+
+   function New_Vars (Pool : Text.Pool.Reference;
+                      Context : Events.Context.Instance)
+                      return not null Pointer is
+     (new Instance'(Transformator.Instance with Context => Context,
+                    others => <>));
+
+   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
+           "@@vars 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
+      if E.Kind /= Mapping_Start then
+         raise Annotation_Error with
+           "@@vars must be applied on a mapping.";
+      end if;
+      Object.State := At_Mapping_Level'Access;
+   end After_Annotation_End;
+
+   procedure At_Mapping_Level (Object : in out Instance; E : Event) is
+   begin
+      case E.Kind is
+         when Scalar =>
+            Object.Cur_Name := E.Content;
+            Object.State := Inside_Value'Access;
+         when Mapping_End =>
+            Object.State := After_Mapping_End'Access;
+         when others =>
+            raise Annotation_Error with
+              "mapping annotated with @@vars must only have scalar keys";
+      end case;
+   end At_Mapping_Level;
+
+   procedure Inside_Value (Object : in out Instance; E : Event) is
+      use type Events.Context.Location_Type;
+      use type Text.Reference;
+   begin
+      if Object.Depth = 0 then
+         declare
+            Modified_Event : Event := E;
+         begin
+            case E.Kind is
+               when Scalar =>
+                  Modified_Event.Scalar_Properties.Anchor := Object.Cur_Name;
+               when Mapping_Start | Sequence_Start =>
+                  Modified_Event.Collection_Properties.Anchor :=
+                    Object.Cur_Name;
+               when Alias =>
+                  declare
+                     Pos : constant Events.Context.Cursor
+                       := Events.Context.Position (Object.Context, E.Target);
+                  begin
+                     if Events.Context.Location (Pos) = Events.Context.None then
+                        raise Annotation_Error with
+                          "unresolvable alias: *" & E.Target;
+                     end if;
+                     declare
+                        Referenced_Events :
+                          constant Events.Store.Stream_Reference :=
+                            Events.Context.Retrieve (Pos);
+                        Depth : Natural := 0;
+                     begin
+                        Modified_Event := Referenced_Events.Value.Next;
+                        case Modified_Event.Kind is
+                           when Mapping_Start | Sequence_Start =>
+                              Modified_Event.Collection_Properties.Anchor :=
+                                Object.Cur_Name;
+                           when Scalar =>
+                              Modified_Event.Scalar_Properties.Anchor :=
+                                Object.Cur_Name;
+                           when others =>
+                              raise Program_Error with
+                                "alias referenced " & Modified_Event.Kind'Img;
+                        end case;
+                        loop
+                           Events.Context.Stream_Store
+                             (Object.Context).Value.Memorize (Modified_Event);
+                           case Modified_Event.Kind is
+                           when Mapping_Start | Sequence_Start =>
+                              Depth := Depth + 1;
+                           when Mapping_End | Sequence_End =>
+                              Depth := Depth - 1;
+                           when others => null;
+                           end case;
+                           exit when Depth = 0;
+                           Modified_Event := Referenced_Events.Value.Next;
+                        end loop;
+                     end;
+                  end;
+                  Object.State := At_Mapping_Level'Access;
+                  return;
+               when others =>
+                  raise Stream_Error with
+                    "Unexpected event (expected node start): " & E.Kind'Img;
+            end case;
+            Object.Cur_Queue.Append (Modified_Event);
+         end;
+      elsif E.Kind = Alias then
+         declare
+            Pos : constant Events.Context.Cursor
+              := Events.Context.Position (Object.Context, E.Target);
+         begin
+            if Events.Context.Location (Pos) = Events.Context.None then
+               raise Annotation_Error with
+                 "unresolvable alias: *" & E.Target;
+            end if;
+            declare
+               Referenced_Events : constant Events.Store.Stream_Reference :=
+                 Events.Context.Retrieve (Pos);
+               Depth : Natural := 0;
+               Cur_Event : Event := Referenced_Events.Value.Next;
+            begin
+               loop
+                  Object.Cur_Queue.Append (Cur_Event);
+                  case Cur_Event.Kind is
+                     when Mapping_Start | Sequence_Start =>
+                        Depth := Depth + 1;
+                     when Mapping_End | Sequence_End =>
+                        Depth := Depth - 1;
+                     when others => null;
+                  end case;
+                  exit when Depth = 0;
+                  Cur_Event := Referenced_Events.Value.Next;
+               end loop;
+            end;
+         end;
+      else
+         Object.Cur_Queue.Append (E);
+      end if;
+      case E.Kind is
+         when Mapping_Start | Sequence_Start =>
+            Object.Depth := Object.Depth + 1;
+            return;
+         when Mapping_End | Sequence_End =>
+            Object.Depth := Object.Depth - 1;
+         when others => null;
+      end case;
+      if Object.Depth = 0 then
+         loop
+            Events.Context.Stream_Store (Object.Context).Value.Memorize
+              (Object.Cur_Queue.First);
+            Object.Cur_Queue.Dequeue;
+            exit when Object.Cur_Queue.Length = 0;
+         end loop;
+         Object.State := At_Mapping_Level'Access;
+      end if;
+   end Inside_Value;
+
+   procedure After_Mapping_End (Object : in out Instance; E : Event) is
+   begin
+      raise Constraint_Error with
+        "unexpected input to @@vars (already finished)";
+   end After_Mapping_End;
+begin
+   Map.Include ("vars", New_Vars'Access);
+end Yaml.Transformator.Annotation.Vars;

src/implementation/yaml-transformator-annotation-vars.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;
+private with Yaml.Events.Queue;
+
+package Yaml.Transformator.Annotation.Vars 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;
+
+   overriding function Swallows_Document (Object : in out Instance)
+                                          return Boolean is (True);
+
+   function New_Vars (Pool : Text.Pool.Reference;
+                      Context : Events.Context.Instance)
+                      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 At_Mapping_Level (Object : in out Instance; E : Event);
+   procedure Inside_Value (Object : in out Instance; E : Event);
+   procedure After_Mapping_End (Object : in out Instance; E : Event);
+
+   type Instance is limited new Transformator.Instance with record
+      Context : Events.Context.Instance;
+      Depth : Natural := 0;
+      State : State_Type := Initial'Access;
+      Cur_Queue : Events.Queue.Instance;
+      Cur_Name : Text.Reference;
+   end record;
+end Yaml.Transformator.Annotation.Vars;