uwrap/src/wrapping-runtime-frames.adb

------------------------------------------------------------------------------
--                                                                          --
--                                  UWrap                                   --
--                                                                          --
--                       Copyright (C) 2020, AdaCore                        --
--                                                                          --
-- UWrap is free software;  you can  redistribute it  and/or modify it      --
-- under terms of the  GNU General Public License as published  by the Free --
-- Software  Foundation;  either version 3,  or (at your option) any later  --
-- version.  UWrap is distributed in the hope that it will be useful, but   --
-- WITHOUT ANY WARRANTY;  without even the  implied warranty of MERCHANTA-  --
-- BILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public  --
-- License for  more details.  You should have  received  a copy of the GNU --
-- General Public License  distributed with UWrap; see file COPYING3.  If   --
-- not, go to http://www.gnu.org/licenses for a complete copy of the        --
-- license.                                                                 --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Strings;                 use Ada.Strings;
with Ada.Strings.Wide_Wide_Fixed; use Ada.Strings.Wide_Wide_Fixed;
with Ada.Containers;              use Ada.Containers;

with Wrapping.Runtime.Objects; use Wrapping.Runtime.Objects;
with Wrapping.Runtime.Nodes;   use Wrapping.Runtime.Nodes;
with Wrapping.Utils;           use Wrapping.Utils;

package body Wrapping.Runtime.Frames is

   Data_Frame_Stack : Data_Frame_Vectors.Vector;
   --  Stores the frames as they're pushed and pop during the evaluation of
   --  the program.

   procedure Update_Top_Object;
   --  Updates the global reference to the top object, called when an object is
   --  pushed or popped.

   procedure Update_Top_And_Parent_Frames;
   --  Updates the global references to top and parent frames, called when
   --  a framed is pushed or popped.

   -----------------
   --  Call_Yield --
   -----------------

   procedure Call_Yield
     (Callback : Yield_Callback_Type := Top_Context.Yield_Callback)
   is
   begin
      if Callback /= null then
         Push_Frame_Context;

         --  Yield is not transitive. For example in something like:
         --     child ().filter (condition)
         --  child will values to filter, calling the callback on the
         --  condition. That condition should not be yeilding.

         Top_Context.Yield_Callback := null;

         Callback.all;

         --  A yield callback is supposed to push its result on the stack.
         --  Call_Yield semantic is to replace the current top by the new one
         --  coming from the callback, so pops the previous top.

         Pop_Underneath_Top;

         Pop_Frame_Context;
      end if;
   end Call_Yield;

   ------------------------
   -- Get_Visible_Symbol --
   ------------------------

   function Get_Local_Symbol (Name : Text_Type) return W_Object is
   begin
      if Top_Frame.Symbols.Contains (Name) then
         return Top_Frame.Symbols.Element (Name);
      end if;

      return null;
   end Get_Local_Symbol;

   ----------------
   -- Get_Module --
   ----------------

   function Get_Module
     (A_Frame : Data_Frame_Type) return T_Module
   is
      Scope : T_Entity := A_Frame.Lexical_Scope;
   begin
      --  Look for the current scope, which could be any lexical entity
      --  containing other entities (e.g. a command, a template, a function...)
      --  Look for the parent up until we reach the module.

      while Scope /= null and then Scope.all not in T_Module_Type'Class loop
         Scope := Scope.Parent;
      end loop;

      return T_Module (Scope);
   end Get_Module;

   -----------------------
   -- Update_Top_Object --
   -----------------------

   procedure Update_Top_Object is
   begin
      if Top_Frame /= null and then Top_Frame.Data_Stack.Length > 0 then
         Top_Object_Ref := Top_Frame.Data_Stack.Last_Element;
      end if;
   end Update_Top_Object;

   -----------------
   -- Push_Object --
   -----------------

   procedure Push_Object (Object : access W_Object_Type'Class) is
   begin
      --  We should never push a reference pointing to null. Check that it's
      --  indeed the case.

      pragma Assert (if Object.all in W_Reference_Type'Class then
                        W_Reference (Object).Value /= null);

      Top_Frame.Data_Stack.Append (W_Object (Object));
      Update_Top_Object;
   end Push_Object;

   ----------------------
   -- Push_Implicit_It --
   ----------------------

   procedure Push_Implicit_It (Object : access W_Object_Type'Class) is
   begin
      Top_Context.It_Value := W_Object (Object);
      Push_Object (Top_Context.It_Value);
   end Push_Implicit_It;

   ---------------------------
   -- Push_Allocated_Entity --
   ---------------------------

   procedure Push_Allocated_Entity (Object : access W_Object_Type'Class) is
   begin
      Push_Object
        (W_Object'
           (new W_Reference_Type'
                (Value        => W_Object (Object),
                 Is_Allocated => True)));
   end Push_Allocated_Entity;

   -------------------------
   -- Push_Temporary_Name --
   -------------------------

   procedure Push_Temporary_Name (Name : Text_Type; Object : W_Object)
   is
      Node : constant W_Node := W_Node (Object);
      Node_Map : Text_Maps_Access;
   begin
      --  Checks if the frame already has temporaries for the object in
      --  parameter. Either retreives the corresponding set of names or create
      --  one

      if Top_Frame.Temp_Names.Contains (Object) then
         Node_Map := Top_Frame.Temp_Names.Element (Object);
      else
         Node_Map := new Text_Maps.Map;
         Top_Frame.Temp_Names.Insert (Object, Node_Map);
      end if;

      --  Check if the list of names already has a temporary for the name in
      --  parameter. If yes, push it, if not, increment the tmp counter for
      --  this object and push the temporary.

      if Node_Map.Contains (Name) then
         Push_Object (To_W_String (Node_Map.Element (Name)));
      else
         Node.Tmp_Counter := Node.Tmp_Counter + 1;

         declare
            Tmp : constant Text_Type :=
              "Temp_" & (if Name /= "" then Name & "_" else "") &
              Trim (Integer'Wide_Wide_Image (Node.Tmp_Counter), Both);
         begin
            Node_Map.Insert (Name, Tmp);

            Push_Object (To_W_String (Tmp));
         end;
      end if;
   end Push_Temporary_Name;

   ----------------
   -- Pop_Object --
   ----------------

   procedure Pop_Object is
   begin
      Top_Frame.Data_Stack.Delete_Last;
      Update_Top_Object;
   end Pop_Object;

   ------------------------
   -- Pop_Underneath_Top --
   ------------------------

   procedure Pop_Underneath_Top is
   begin
      Top_Frame.Data_Stack.Delete (Integer (Top_Frame.Data_Stack.Length) - 1);
      Update_Top_Object;
   end Pop_Underneath_Top;

   ----------------
   -- Pop_Object --
   ----------------

   function Pop_Object return W_Object is
      Result : W_Object;
   begin
      Result := Top_Frame.Data_Stack.Last_Element;
      Pop_Object;
      Update_Top_Object;

      return Result;
   end Pop_Object;

   ------------------------
   -- Push_Frame_Context --
   ------------------------

   procedure Push_Frame_Context is
   begin
      Push_Frame_Context (Top_Context.all);
   end Push_Frame_Context;

   ----------------------------------
   -- Push_Frame_Context_Parameter --
   ----------------------------------

   procedure Push_Frame_Context_Parameter is
   begin
      --  When pushing a context with a regular parameter, we're not supposed
      --  to match its result with anything, and the expression as a whole
      --  is a root selection (ie it has no prefix).

      Push_Frame_Context_No_Match;
      Top_Context.Is_Root_Selection := True;
   end Push_Frame_Context_Parameter;

   ---------------------------------------------
   -- Push_Frame_Context_Parameter_With_Match --
   ---------------------------------------------

   procedure Push_Frame_Context_Parameter_With_Match (Object : W_Object) is
   begin
      --  When pushing a context with a parameter to be matched, we need
      --  to set the mode as the default match for a reference (it will be
      --  changed by the expression if needed), set the action to be a match
      --  against the object in parameter. The expression is a root expression
      --  (it has no prefix).

      Push_Frame_Context;
      Top_Context.Is_Root_Selection := True;
      Top_Context.Match_Mode        := Match_Ref_Default;
      Top_Context.Outer_Expr_Action := Action_Match;
      Top_Context.Outer_Object      := Object;
   end Push_Frame_Context_Parameter_With_Match;

   ---------------------------------
   -- Push_Frame_Context_No_Outer --
   ---------------------------------

   procedure Push_Frame_Context_No_Outer is
   begin
      --  Remove all data used for the outer actions (the result callback,
      --  expr action and outer object). Match_Mode is ketp unchanged, as it's
      --  also used to control wether a reference not found is an error or if
      --  it just signals a expression not matching.

      Push_Frame_Context;
      Top_Context.Function_Result_Callback := null;
      Top_Context.Outer_Expr_Action        := Action_None;
      Top_Context.Outer_Object             := null;
   end Push_Frame_Context_No_Outer;

   ---------------------------------
   -- Push_Frame_Context_No_Match --
   ---------------------------------

   procedure Push_Frame_Context_No_Match is
   begin
      --  Sets a frame context as not being matching - there's no outer action,
      --  no match mode and no match object.

      Push_Frame_Context;
      Top_Context.Match_Mode        := Match_None;
      Top_Context.Outer_Expr_Action := Action_None;
      Top_Context.Outer_Object      := null;
   end Push_Frame_Context_No_Match;

   --------------------------------
   -- Push_Frame_Context_No_Pick --
   --------------------------------

   procedure Push_Frame_Context_No_Pick is
   begin
      --  Set a frame with no pick action, that is to say no call to function
      --  after processing and no outer pick action.

      Push_Frame_Context;
      Top_Context.Function_Result_Callback := null;
      Top_Context.Outer_Expr_Action        := Action_None;
   end Push_Frame_Context_No_Pick;

   ------------------------
   -- Push_Frame_Context --
   ------------------------

   procedure Push_Frame_Context (Context : Frame_Context_Type) is
      Parent : constant Frame_Context := Top_Context;
   begin
      Top_Frame.Top_Context := new Frame_Context_Type'(Context);
      Top_Context.Parent_Context := Parent;
   end Push_Frame_Context;

   -----------------------
   -- Pop_Frame_Context --
   -----------------------

   procedure Pop_Frame_Context is
   begin
      Top_Frame.Top_Context := Top_Context.Parent_Context;
   end Pop_Frame_Context;

   -------------------------------
   -- Push_Match_Groups_Section --
   -------------------------------

   procedure Push_Match_Groups_Section is
   begin
      Top_Frame.Group_Sections.Append (new Matched_Groups_Type);
   end Push_Match_Groups_Section;

   ------------------------------
   -- Pop_Match_Groups_Section --
   ------------------------------

   procedure Pop_Match_Groups_Section is
   begin
      Top_Frame.Group_Sections.Delete_Last;
   end Pop_Match_Groups_Section;

   ----------------------------------
   -- Update_Top_And_Parent_Frames --
   ----------------------------------

   procedure Update_Top_And_Parent_Frames is
   begin
      if Data_Frame_Stack.Length > 0 then
         Top_Frame_Ref := Data_Frame_Stack.Last_Element;
      else
         Top_Frame_Ref := null;
      end if;

      if Data_Frame_Stack.Length > 1 then
         Parent_Frame_Ref :=
           Data_Frame_Stack.Element (Data_Frame_Stack.Last_Index - 1);
      else
         Parent_Frame_Ref := null;
      end if;

      Update_Top_Object;
   end Update_Top_And_Parent_Frames;

   ----------------
   -- Push_Frame --
   ----------------

   procedure Push_Frame (Lexical_Scope : access T_Entity_Type'Class) is
      New_Frame : constant Data_Frame := new Data_Frame_Type;
   begin
      New_Frame.Lexical_Scope := T_Entity (Lexical_Scope);
      New_Frame.Top_Context   := new Frame_Context_Type;

      if Parent_Frame /= null then
         --  If there's a parent frame, some context data needs to be passed
         --  to the child:

         --  the link to the visit decision variable, as in:
         --     wrap A_Template ()
         --  the frame within A_Template can decide to change the iteration
         --  that leads to the wrap command
         New_Frame.Top_Context.Visit_Decision := Top_Context.Visit_Decision;

         --  The indentation, as indentation of a child frame starts at the
         --  identation level of its parent (so that so functions and template
         --  can create their own indented section contributing to the global
         --  output).
         New_Frame.Top_Context.Indent := Top_Context.Indent;
      end if;

      --  Each new frame create a new temporary names registry
      New_Frame.Temp_Names := new Tmp_Maps.Map;

      Data_Frame_Stack.Append (New_Frame);
      Update_Top_And_Parent_Frames;
   end Push_Frame;

   ----------------
   -- Push_Frame --
   ----------------

   procedure Push_Frame (Frame : Data_Frame) is
   begin
      Data_Frame_Stack.Append (Frame);
      Update_Top_And_Parent_Frames;
   end Push_Frame;

   ----------------
   -- Push_Frame --
   ----------------

   procedure Push_Frame (A_Closure : Closure) is
   begin
      --  First, push a frame on the captured lexical scope
      Push_Frame (A_Closure.Lexical_Scope);

      --  Copy symbols from the closure to the new symbol tree
      Top_Frame.Symbols := A_Closure.Captured_Symbols.Copy;

      --  All closure share the same temporary names
      Top_Frame.Temp_Names := A_Closure.Temp_Names;

      --  Retreives the left value at the point of capture
      Top_Context.Left_Value := A_Closure.Left_Value;

      --  Retreives the implicit it value at the point of capture
      Push_Implicit_It (A_Closure.Implicit_It);
   end Push_Frame;

   ---------------
   -- Pop_Frame --
   ---------------

   procedure Pop_Frame is
   begin
      Data_Frame_Stack.Delete_Last;
      Update_Top_And_Parent_Frames;
   end Pop_Frame;

   ---------------------
   -- Get_Implicit_It --
   ---------------------

   function Get_Implicit_It return W_Object is
   begin
      return Top_Context.It_Value;
   end Get_Implicit_It;

end Wrapping.Runtime.Frames;