------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                          A S I S . S E T _ G E T                         --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (C) 1995-2010, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT 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 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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 ASIS-for-GNAT; see file     --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  AdaCore                   --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Calendar;       use Ada.Calendar;

with Asis.Extensions;    use Asis.Extensions;

package Asis.Set_Get is

   pragma Elaborate_Body (Asis.Set_Get);

--  This package contains the interface routines for setting and getting
--  the values of the internal components of the main ASIS abstractions -
--  Context, Compilation_Unit and Element. All the operations for getting
--  components are defined as functions, but the operations for obtaining
--  the tree nodes from an Element value may change the tree being accessed,
--  which should be considered as the side effect.

--  THE DOCUMENTATION IS INCOMPLETE!!!!!

   ---------------------------------------
   -- String -> Program_Text conversion --
   ---------------------------------------

   function To_Program_Text (S : String) return Program_Text;
   --  This function takes the string which is a part of the source code
   --  representation and converts it into ASIS Program_Text type. It tries
   --  to recognize the wide character encoding and to convert it back into
   --  Wide_Character

   -------------
   -- CONTEXT --
   -------------

   -------------------------------------
   -- Id <-> ASIS Context conversions --
   -------------------------------------

   function Get_Cont_Id (C  : Context)    return Context_Id;
   function Get_Cont    (Id : Context_Id) return Context;

   procedure Set_Cont   (C  : out Context; Id : Context_Id);
   --  Assigns the value of Id to the Id fields of a given variable C
   --  of the Asis Context type

   pragma Inline (Get_Cont_Id);
   pragma Inline (Get_Cont);

   --------------------------------
   -- Getting Context Attributes --
   --------------------------------

   function Valid (C : Context) return Boolean;
   --  checks if its argument is an opened (=valid) Context
   --  DO WE REALLY NEED THIS FUNCTION??

----------------------
-- COMPILATION_UNIT --
----------------------

   ----------------------------------------------
   -- Id <-> ASIS Compilation Unit conversions --
   ----------------------------------------------

   function Get_Unit_Id   (C_U : Compilation_Unit) return Unit_Id;

   function Get_Comp_Unit
     (U  : Unit_Id;
      C  : Context_Id)
      return Compilation_Unit;
   --  this function creates the new value of the Compilation_Unit
   --  type; note, that it also sets the field Obtained as equal to
   --  the current OS time

   function Get_Comp_Unit_List
     (U_List : Unit_Id_List;
      C      : Context_Id)
      return Compilation_Unit_List;
   --  Creates the ASIS Compilation Unit List from the list of unit Ids

   pragma Inline (Get_Unit_Id);
   pragma Inline (Get_Comp_Unit);

   -----------------------------------------
   -- Getting Compilation Unit Attributes --
   -----------------------------------------

   function Not_Nil (C_U : Compilation_Unit) return Boolean;
   --  Check if C_U /= Nil_Compilation_Unit (the name "Exists" is already
   --  busy in ASIS

   function Nil (C_U : Compilation_Unit) return Boolean;
   --  Check if C_U = Nil_Compilation_Unit

   function Is_Standard (C_U : Compilation_Unit) return Boolean;
   --  Check if C_U represents the predefined package Standard

   function Kind             (C_U : Compilation_Unit) return Asis.Unit_Kinds;
   function Class            (C_U : Compilation_Unit) return Unit_Classes;
   function Origin           (C_U : Compilation_Unit) return Unit_Origins;
   function Is_Main_Unit     (C_U : Compilation_Unit) return Boolean;
   function Top              (C_U : Compilation_Unit) return Node_Id;
   function Is_Body_Required (C_U : Compilation_Unit) return Boolean;
   function Unit_Name        (C_U : Compilation_Unit) return String;
   function Encl_Cont        (C_U : Compilation_Unit) return Context;
   function Encl_Cont_Id     (C_U : Compilation_Unit) return Context_Id;
   function Source_File      (C_U : Compilation_Unit) return String;
   function Ref_File         (C_U : Compilation_Unit) return String;
   function Context_Info     (C_U : Compilation_Unit) return String;
   function Time_Stamp       (C_U : Compilation_Unit) return Time;
   function Source_Status    (C_U : Compilation_Unit)
      return Source_File_Statuses;
   function Main_Tree        (C_U : Compilation_Unit) return Tree_Id;

   -------------------
   -- Miscellaneous --
   -------------------

   function "=" (Left, Right : Compilation_Unit) return Boolean;
   --  This function "re-implements" the equivalent-to-predefined
   --  compare operation for Compilation_Unit. It should never be used in
   --  any ASIS application code.

   function Valid (C_U : Compilation_Unit) return Boolean;
   --  checks, if the argument is valid, that is, if its enclosing
   --  Context is opened

   procedure Reset_Main_Tree (C_U : Compilation_Unit);
   --  If C_U is a main unit in some tree, this procedure resets
   --  this tree, otherwise it does nothing. This procedure does not
   --  reset the context, it should be done by a caller.

   function Get_Configuration_CU
     (C_U :  Compilation_Unit)
      return Compilation_Unit;
   --  Returns the ASIS COmpilation unit which represents
   --  A_Configuration_Compilation in the enclosing context of C_U

   pragma Inline (Not_Nil);
   pragma Inline (Nil);
   pragma Inline (Is_Standard);
   pragma Inline (Kind);
   pragma Inline (Class);
   pragma Inline (Origin);
   pragma Inline (Is_Main_Unit);
   pragma Inline (Top);
   pragma Inline (Is_Body_Required);
   pragma Inline (Unit_Name);
   pragma Inline (Encl_Cont);
   pragma Inline (Encl_Cont_Id);
   pragma Inline (Valid);

   --  THIS "INLINE" LIST IS INCOMPLETE!!!

-------------
-- ELEMENT --
-------------

   function "=" (Left, Right : Element) return Boolean;
   --  This function "re-implements" the equivalent-to-predefined
   --  compare operation for Elements. It should never be used in
   --  any ASIS application code.

   ---------
   -- Get --
   ---------

   function Node               (E : Element) return Node_Id;
   function R_Node             (E : Element) return Node_Id;
   function Node_Field_1       (E : Element) return Node_Id;
   function Node_Field_2       (E : Element) return Node_Id;
   function Node_Value         (E : Element) return Node_Id;
   function R_Node_Value       (E : Element) return Node_Id;
   function Node_Field_1_Value (E : Element) return Node_Id;
   function Node_Field_2_Value (E : Element) return Node_Id;
   --  Node, R_Node and Node_Field_1 reset the tree when returning
   --  the node value in a way that the returned node will be the
   --  proper node value for the tree being accessed by ASIS,
   --  whereas Node_Value, R_Node_Value and Node_Field_1_Value
   --  just return the node value without changing the currently
   --  accessed tree

   function Encl_Unit          (E : Element) return Compilation_Unit;
   function Encl_Unit_Id       (E : Element) return Unit_Id;
   function Encl_Cont          (E : Element) return Context;
   function Encl_Cont_Id       (E : Element) return Context_Id;
   function Kind               (E : Element) return Asis.Element_Kinds;
   function Int_Kind           (E : Element) return Internal_Element_Kinds;
   function Is_From_Implicit   (E : Element) return Boolean;
   function Is_From_Inherited  (E : Element) return Boolean;
   function Is_From_Instance   (E : Element) return Boolean;
   function Special_Case       (E : Element) return Special_Cases;
   function Normalization_Case (E : Element) return Normalization_Cases;
   function Parenth_Count      (E : Element) return Nat;
   function Encl_Tree          (E : Element) return Tree_Id;
   function Rel_Sloc           (E : Element) return Source_Ptr;
   function Character_Code     (E : Element) return Char_Code;
   function Obtained           (E : Element) return ASIS_OS_Time;

   function Location      (E : Asis.Element) return Source_Ptr;
   --  this function returns not relative (as Rel_Sloc does), but
   --  "absolute" location of the source position corresponding
   --  to the Node on which E is based. This function is
   --  "tree-swapping-safe"

   function Valid             (E : Element) return Boolean;
   --  checks, if the argument is valid, that is, if the enclosing
   --  Context of its enclosing Unit is opened

   pragma Inline (Node);
   pragma Inline (R_Node);
   pragma Inline (Encl_Unit);
   pragma Inline (Encl_Unit_Id);
   pragma Inline (Encl_Cont);
   pragma Inline (Encl_Cont_Id);
   pragma Inline (Kind);
   pragma Inline (Int_Kind);
   pragma Inline (Is_From_Implicit);
   pragma Inline (Is_From_Inherited);
   pragma Inline (Is_From_Instance);
   pragma Inline (Special_Case);
   pragma Inline (Encl_Tree);
   pragma Inline (Rel_Sloc);
   pragma Inline (Valid);

   ---------
   -- Set --
   ---------

   procedure Set_Node               (E : in out Element; N : Node_Id);
   procedure Set_R_Node             (E : in out Element; N : Node_Id);
   procedure Set_Node_Field_1       (E : in out Element; N : Node_Id);
   procedure Set_Node_Field_2       (E : in out Element; N : Node_Id);
   procedure Set_Encl_Unit_Id       (E : in out Element; U : Unit_Id);
   procedure Set_Enclosing_Context  (E : in out Element; C : Context_Id);
   procedure Set_Obtained           (E : in out Element; T : ASIS_OS_Time);
   procedure Set_Int_Kind           (E : in out Element;
                                                 K :  Internal_Element_Kinds);
   procedure Set_From_Implicit      (E : in out Element; I : Boolean := True);
   procedure Set_From_Inherited     (E : in out Element; I : Boolean := True);
   procedure Set_From_Instance      (E : in out Element; I : Boolean := True);
   procedure Set_Special_Case       (E : in out Element; S : Special_Cases);
   procedure Set_Rel_Sloc           (E : in out Element; S : Source_Ptr);
   procedure Set_Character_Code     (E : in out Element; C : Char_Code);
   procedure Set_Encl_Tree          (E : in out Element; T : Tree_Id);
   procedure Set_Normalization_Case (E : in out Element;
                                                 N : Normalization_Cases);
   procedure Set_Parenth_Count      (E : in out Element; Val : Nat);

   function Set_Element
     (Node           : Node_Id;
      R_Node         : Node_Id;
      Node_Field_1   : Node_Id;
      Node_Field_2   : Node_Id;
      Encl_Unit      : Compilation_Unit;
      --  contains Ids for both Enclosing Compilation Unit and Enclosing
      --  Context
      Int_Kind       : Internal_Element_Kinds;
      Implicit       : Boolean;
      Inherited      : Boolean;
      Instance       : Boolean;
      Spec_Case      : Special_Cases;
      Norm_Case      : Normalization_Cases;
      Par_Count      : Nat;
      Character_Code : Char_Code)
      return Element;
   --  Constructs and returns the ASIS Element value on the base of
   --  Element attributes
   --  Note, that it should not be any parameter passed for the
   --  Enclosing_Tree field, because this field should be set equal
   --  to the Id of the tree being currently accessed!
   --  Note also, that it should not be any parameter passed for the
   --  Rel_Scr field, because this field should be computed as the
   --  difference between the source location of the node upon
   --  the given element is to be built (that is, passed as the
   --  actual for the Node parameter, and the top node of the
   --  Element's enclosing Unit.
   --
   --  It is supposed, that this function is called as the part of the
   --  constructing of the new element during processing some ASIS
   --  query, so the actuals for Node, R_Node and the current setting of
   --  the top node for the Unit pointed by Encl_Unit are consistent.
   --  See also A4G.Mapping (body).

   function Set_In_List
     (EL           : Element_List;
      Node_Field_1 : Node_Id := Empty;
      Implicit     : Boolean := False;
      Inherited    : Boolean := False)
      return         Element_List;
   --  For all the Elements in EL sets their fields Node_Field_1,
   --  Is_Part_Of_Implicit, Is_Part_Of_Inherited to the values passed as
   --  actuals accordingly for Node_Field_1, Implicit and Inherited.

   procedure Convert_To_Limited_View (El : in out Asis.Element);
   --  Provided that A4G.A_Sem.Belongs_To_Limited_View (El), changes its
   --  internal representation in such a way that El represents the limited
   --  view of the corresponding type or package. This includes changing of the
   --  Element kind for type elements.

   Char_Literal_Spec_Template : Element;
   --  Used as a template for creating lists of
   --  An_Enumeration_Literal_Specification representing defining
   --  character literals of types Standard.Character and
   --  Standard.Wide_Character. This variable is initialized in package body

   Numeric_Error_Template : Element;
   --  Used as a template for the artificial elements representing the obsolete
   --  renaming of Numeric_Error exception in package Standard and components
   --  thereof.

   -----------------------------------------------------------
   -- Special processing for Elements representing root and --
   -- universal numeric types in ASIS                       --
   -----------------------------------------------------------

   function Set_Root_Type_Declaration
     (Int_Kind : Internal_Element_Kinds;
      Cont     : Context_Id)
      return Element;
   --  Constructs and returns the ASIS Element representing the declaration
   --  of a root or universal numeric type. If an actual for Int_Kind does
   --  not belong to Internal_Root_Type_Kinds, Nil_Element is returned.
   --  Otherwise the child element of the result returned by the
   --  Type_Declaration_View function should be of Int_Kind kind.
   --  Every opened Context contains exactly one Element representing
   --  the declaration of a given root or universal numeric type.
   --  These elements (as well as their child elements) have no Node to
   --  be based upon (they simply do not need such a Node), they are
   --  implicit declarations located in the predefined Standard package.

   function Is_Root_Num_Type (Declaration : Asis.Declaration) return Boolean;
   --  Checks if Declaration is A_Type_Declaration Element representing
   --   the declaration of a root or universal numeric type.

   function Root_Type_Definition
     (Declaration : Asis.Declaration)
      return Asis.Definition;
   --  Transforms A_Type_Declaration Element representing the declaration
   --  of a root or universal numeric type into the corresponding type
   --  definition (being of Root_Type_Kinds). This function does not
   --  check if its argument really represents the declaration of a root
   --  or universal numeric type

end Asis.Set_Get;

Add the ASIS file $i

Add the ASIS file $i


Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  EL.Beans.Methods -- Bean methods
--  Copyright (C) 2010 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Strings;
package EL.Beans.Methods is

   pragma Preelaborate;

   type Method_Binding is tagged limited record
      Name : Util.Strings.Name_Access;
   end record;
   type Method_Binding_Access is access constant Method_Binding'Class;

   type Method_Binding_Array is array (Natural range <>) of Method_Binding_Access;
   type Method_Binding_Array_Access is access constant Method_Binding_Array;

   type Method_Bean is limited Interface;
   type Method_Bean_Access is access all Method_Bean'Class;

   function Get_Method_Bindings (From : in Method_Bean)
                                 return Method_Binding_Array_Access is abstract;

end EL.Beans.Methods;

Declare the method binding types

Declare the method binding types


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                            A 4 G . A _ O P T                             --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (C) 1995-2012, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT 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 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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 ASIS-for-GNAT;  see file --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences. ASIS-for-GNAT is now maintained by AdaCore                     --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

--  This package contains global switches set by the
--  Asis_Environment.Initialize routine from the Parameters siting and
--  referenced throughout the ASIS-for-GNAT
--
--  This package may be considered as an ASIS analog of the GNAT Opt
--  package

package A4G.A_Opt is

   Is_Initialized  : Boolean := False;
   --  flag indicating if the environment has already been initialized.

   Was_Initialized_At_Least_Once : Boolean := False;
   --  flag indicating if the environment was initialized at least
   --  once during the current launch of an ASIS application

   type ASIS_Warning_Mode_Type is (Suppress, Normal, Treat_As_Error);
   ASIS_Warning_Mode : ASIS_Warning_Mode_Type := Normal;
   --  Controls treatment of warning messages. If set to Suppress, warning
   --  messages are not generated at all. In Normal mode, they are generated
   --  but do not count as errors. In Treat_As_Error mode, a warning is
   --  treated as an error: ASIS_Failed is raised and the warning message is
   --  sent to an ASIS Diagnosis string.

   Strong_Version_Check : Boolean := True;
   --  Strong version check means that version strings read from the tree and
   --  stored in Gnatvsn are compared. Weak check means comparing ASIS version
   --  numbers. See BA23-002

   Generate_Bug_Box : Boolean := True;
   --  Flag indicating if the ASIS bug box should be generated into Stderr
   --  when an ASIS implementation bug is detected.

   Keep_Going : Boolean := False;
   --  Flag indicating if the exit to OS should NOT be generated in case if
   --  ASIS internal implementation error. Set ON by Initialize '-k' parameter.

   ASIS_2005_Mode_Internal : Boolean := True;
   --  If this switch is ON, ASIS detects as predefined units also units listed
   --  as predefined in the 2005 revision of the Ada Standard. Now this flag is
   --  always ON, and we do not have any parameter to tell ASIS that only
   --  Ada 95 predefined units should be classified as predefined Compilation
   --  Units in ASIS.

   procedure Process_Initialization_Parameters (Parameters : String);
   --  Processes a Parameters string passed to the
   --  Asis.Implementation.Initialize query: check parameters and makes the
   --  corresponding settings for ASIS global switches and flags.

   procedure Process_Finalization_Parameters (Parameters : String);
   --  Processes a Parameters string passed to the
   --  Asis.Implementation.Finalize query.

   procedure Set_Off;
   --  Sets Is_Initialized flag OFF and then sets all the global switches
   --  except Was_Initialized_At_Least_Once in the initial (default) position.
   --  Is to be called by Asis_Environment.Finalize

   --  the type declarations below should probably be moved into A_Types???

   type  Context_Mode is
   --  different ways to define an ASIS Context:
     (One_Tree,
      --  a Context is made up by only one tree file
      N_Trees,
      --  a Context is made up by N tree files
      Partition,
      --  a partition Context
      All_Trees);
      --  all the tree files in tree search path are considered as making up a
      --  given Context

   type Tree_Mode is
   --  how ASIS deals with tree files
     (On_The_Fly,
      --  trees are created on the fly, created trees are reused as long as a
      --  Context remains opened
      Pre_Created,
      --  only those trees which have been created before a Context is opened
      --  are used
      Mixed,
      --  mixed approach - if ASIS cannot find a needed tree, it tries to
      --  create it on the fly
      Incremental,
      --  Similar to Mixed, but these mode goes beyond the ASIS standard and
      --  allows to change the environment when the Context remains open:
      --  -  when the Context is opened, all the existing trees are processed;
      --  -  if ASIS can not find a needed tree, it tries to create it on the
      --     fly, and it refreshes the information in the Context unit table
      --     using the data from this newly created tree;
      --  -  any access to a unit or to an element checks that a tree to be
      --     accessed is consistent with the sources
      --  ???? This documentation definitely needs revising???
      GNSA
      --  Any tree is created on the fly by calling GNSA. It is not written
      --  in a tree file and then read back by ASIS, but it is left in the
      --  same data structures where it has been created, and after that ASIS
      --  works on the same data structures.
      );

   type Source_Mode is
   --  how ASIS takes into account source files when checking the consistency
     (All_Sources,
      --  sources of all the units from a given Context (except the predefined
      --  Standard package) should be around, and they should be the same as
      --  the sources from which tree files making up the Context were created
      Existing_Sources,
      --  If for a given unit from the Context the corresponding source file
      --  exists, it should be the same as those used to create tree files
      --  making up the Context
      No_Sources);
      --  Existing  source files are not taken into account when checking the
      --  consistency of tree files

end A4G.A_Opt;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  ADO Databases -- Database Objects
--  Copyright (C) 2009, 2010 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Strings;
with ADO.SQL;
package ADO.Queries is

   type Query_Definition_Record is limited record
      Name : Util.Strings.Name_Access;
   end record;

   type Query_Definition is access all Query_Definition_Record;

   type Context is new ADO.SQL.Query with null record;

end ADO.Queries;

Support for queries

Support for queries


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                        A 4 G . T R E E _ R E C                           --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (c) 1995-2005, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT 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 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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 ASIS-for-GNAT; see file     --
-- COPYING. If not, write to the Free Software Foundation,  59 Temple Place --
-- - Suite 330,  Boston, MA 02111-1307, USA.                                --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  Ada Core Technologies Inc --
-- (http://www.gnat.com).                                                   --
--                                                                          --
------------------------------------------------------------------------------

--  This package defines the Tree_Rec type, which is used as an actual for
--  the instantiation of the GANT Table creating the type for the Context tree
--  table. This table stores information about trees (tree output files)
--  cerating the Ada environment processed by a given Context

with A4G.A_Types; use A4G.A_Types;

with Types;       use Types;

package A4G.Tree_Rec is

   --  See the A4G.Contt.TT package for the details of maintaining
   --  the tree tables

   ------------------------------
   -- Tree_Rec type definition --
   ------------------------------

   --  Similar to the Contexts' Unit tables and Source File tables,
   --  Tree tables are organised as Name tables (for the names of the
   --  tree files), and each entry in such a Name table has additional
   --  fields for information related to tree files handling in ASIS.

   type Tree_Record is record

      --------------------------------
      -- Fields for Tree Name Table --
      --------------------------------

      Tree_Name_Chars_Index      : Int;
      --  Starting locations of characters in the Name_Chars table minus
      --  one (i.e. pointer to character just before first character). The
      --  reason for the bias of one is that indexes in Name_Buffer are
      --  one's origin, so this avoids unnecessary adds and subtracts of 1.

      Tree_Name_Len      : Short;
      --  Lengths of the names in characters

      Int_Info : Int;
      --  Int Value associated with this tree

      ---------------------
      -- Tree attributes --
      ---------------------

      Main_Unit : Unit_Id;
      --    The ASIS Compilation Unit, correspondig to the main unit in
      --    the tree

      Main_Top : Node_Id;
      --    The top node (having N_Compilation_Unit Node Kind) of Main_Unit
      --    DO WE REALLY NEED IT?

      Units : Elist_Id;
      --    The list of all the Units (or all the Units except Main_Unit?)
      --    which may be processed on the base of this tree, [each Unit
      --    is accompanied by its top node, which it has in the given tree
      --    ??? Not implemented for now!]

   end record;

end A4G.Tree_Rec;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  Util-strings-sets --  Set of strings
--  Copyright (C) 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Hash;
with Ada.Containers.Indefinite_Hashed_Sets;

--  The <b>Util.Strings.Sets</b> package provides an instantiation
--  of a hashed set with Strings.
package Util.Strings.Sets is new Ada.Containers.Indefinite_Hashed_Sets
  (Element_Type        => String,
   Hash                => Ada.Strings.Hash,
   Equivalent_Elements => "=");

Define the set of string package

Define the set of string package


-----------------------------------------------------------------------
--  util-properties-form -- read json files into properties
--  Copyright (C) 2020 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Serialize.IO.Form;
with Util.Stacks;
with Util.Log;
with Util.Beans.Objects;
package body Util.Properties.Form is

   type Natural_Access is access all Natural;

   package Length_Stack is new Util.Stacks (Element_Type        => Natural,
                                            Element_Type_Access => Natural_Access);

   type Parser is abstract limited new Util.Serialize.IO.Reader with record
      Base_Name        : Ada.Strings.Unbounded.Unbounded_String;
      Lengths          : Length_Stack.Stack;
      Separator        : Ada.Strings.Unbounded.Unbounded_String;
      Separator_Length : Natural;
   end record;

   --  Start a new object associated with the given name.  This is called when
   --  the '{' is reached.  The reader must be updated so that the next
   --  Set_Member procedure will associate the name/value pair on the
   --  new object.
   overriding
   procedure Start_Object (Handler : in out Parser;
                           Name    : in String;
                           Logger  : in out Util.Log.Logging'Class);

   --  Finish an object associated with the given name.  The reader must be
   --  updated to be associated with the previous object.
   overriding
   procedure Finish_Object (Handler : in out Parser;
                            Name    : in String;
                            Logger  : in out Util.Log.Logging'Class);

   overriding
   procedure Start_Array (Handler : in out Parser;
                          Name    : in String;
                          Logger  : in out Util.Log.Logging'Class);

   overriding
   procedure Finish_Array (Handler : in out Parser;
                           Name    : in String;
                           Count   : in Natural;
                           Logger  : in out Util.Log.Logging'Class);

   --  -----------------------
   --  Start a new object associated with the given name.  This is called when
   --  the '{' is reached.  The reader must be updated so that the next
   --  Set_Member procedure will associate the name/value pair on the
   --  new object.
   --  -----------------------
   overriding
   procedure Start_Object (Handler : in out Parser;
                           Name    : in String;
                           Logger  : in out Util.Log.Logging'Class) is
      pragma Unreferenced (Logger);
   begin
      if Name'Length > 0 then
         Ada.Strings.Unbounded.Append (Handler.Base_Name, Name);
         Ada.Strings.Unbounded.Append (Handler.Base_Name, Handler.Separator);
         Length_Stack.Push (Handler.Lengths);
         Length_Stack.Current (Handler.Lengths).all := Name'Length + Handler.Separator_Length;
      end if;
   end Start_Object;

   --  -----------------------
   --  Finish an object associated with the given name.  The reader must be
   --  updated to be associated with the previous object.
   --  -----------------------
   overriding
   procedure Finish_Object (Handler : in out Parser;
                            Name    : in String;
                            Logger  : in out Util.Log.Logging'Class) is
      pragma Unreferenced (Logger);
      Len : constant Natural := Ada.Strings.Unbounded.Length (Handler.Base_Name);
   begin
      if Name'Length > 0 then
         Ada.Strings.Unbounded.Delete (Handler.Base_Name,
                                       Len - Name'Length - Handler.Separator_Length + 1, Len);
      end if;
   end Finish_Object;

   overriding
   procedure Start_Array (Handler : in out Parser;
                          Name    : in String;
                          Logger  : in out Util.Log.Logging'Class) is
   begin
      Handler.Start_Object (Name, Logger);
   end Start_Array;

   overriding
   procedure Finish_Array (Handler : in out Parser;
                           Name    : in String;
                           Count   : in Natural;
                           Logger  : in out Util.Log.Logging'Class) is
   begin
      Parser'Class (Handler).Set_Member ("length", Util.Beans.Objects.To_Object (Count), Logger);
      Handler.Finish_Object (Name, Logger);
   end Finish_Array;

   --  -----------------------
   --  Parse the application/form content and put the flattened content in the property manager.
   --  -----------------------
   procedure Parse_Form (Manager : in out Util.Properties.Manager'Class;
                         Content : in String;
                         Flatten_Separator : in String := ".") is

      type Local_Parser is new Parser with record
         Manager : access Util.Properties.Manager'Class;
      end record;

      --  Set the name/value pair on the current object.  For each active mapping,
      --  find whether a rule matches our name and execute it.
      overriding
      procedure Set_Member (Handler   : in out Local_Parser;
                            Name      : in String;
                            Value     : in Util.Beans.Objects.Object;
                            Logger    : in out Util.Log.Logging'Class;
                            Attribute : in Boolean := False);

      --  -----------------------
      --  Set the name/value pair on the current object.  For each active mapping,
      --  find whether a rule matches our name and execute it.
      --  -----------------------
      overriding
      procedure Set_Member (Handler   : in out Local_Parser;
                            Name      : in String;
                            Value     : in Util.Beans.Objects.Object;
                            Logger    : in out Util.Log.Logging'Class;
                            Attribute : in Boolean := False) is
         pragma Unreferenced (Logger, Attribute);
      begin
         Handler.Manager.Set (Ada.Strings.Unbounded.To_String (Handler.Base_Name) & Name,
                              Util.Beans.Objects.To_String (Value));
      end Set_Member;

      P : Local_Parser;
      R : Util.Serialize.IO.Form.Parser;
   begin
      P.Separator        := Ada.Strings.Unbounded.To_Unbounded_String (Flatten_Separator);
      P.Separator_Length := Flatten_Separator'Length;
      P.Manager          := Manager'Access;
      R.Parse_String (Content, P);
      if R.Has_Error then
         raise Util.Serialize.IO.Parse_Error;
      end if;
   end Parse_Form;

end Util.Properties.Form;

Implement the Parse_Form procedure (taken from Parse_JSON)


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                         A 4 G . E X P R _ S E M                          --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (c) 1995-2005, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT 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 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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 ASIS-for-GNAT; see file     --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  AdaCore                   --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

--  This package contains routines needed for semantic queries from
--  the Asis.Expressions package

with Asis; use Asis;

package A4G.Expr_Sem is

   --  All the routines defined in this package do not check their
   --  arguments - a caller is responsible for the proper use of these
   --  routines

   function Expr_Type (Expression : Asis.Expression) return Asis.Declaration;
   --  using the fact, that Expression is of An_Expression kind and that
   --  the Etype field is set for its Node, this function finds the
   --  type declaration which should be returned as the result of
   --  Corresponding_Expression_Type (Expression)

   function Identifier_Name_Definition
     (Reference_I : Element)
      return        Asis.Defining_Name;

   function Character_Literal_Name_Definition
     (Reference_Ch : Element)
      return         Asis.Defining_Name;
   --  Each of these two functions provides an Element representing the
   --  defining occurrence for its argument, provided that the argument is
   --  of appropriate kind and all the necessary checks have already been
   --  done

   function Is_Reference
     (Name : Asis.Element;
      Ref  : Asis.Element)
      return Boolean;
   --  Provided that Name is of A_Defining_Name kind, this function checks is
   --  Ref is a reference to this name. It is an error to call this function
   --  for any Element which is not of A_Defining_Name as an actual for Name.
   --  Any Element is acceptable as an actual for Ref, and this function does
   --  not raise any exception in any case.
   --
   --  ??? Should we move this function into Asis.Extensions?

   function Needs_List (Reference : Asis.Element) return Boolean;
   --  Supposed to be applied to the argument of the
   --  Corresponding_Name_Definition_List query. Checks if Reference
   --  is ambiguous and refers to more than one entity.

   procedure Collect_Overloaded_Entities (Reference : Asis.Element);
   --  Supposed to be called for the argument of the
   --  Corresponding_Name_Definition_List query in case if Needs_List is
   --  True for it. Collects in the Element Table all the defining
   --  names referred by Reference.
   --  This procedure supposes, that the Element Table is already initialized
   --  in the calling context

   procedure Correct_Result
     (Result    : in out Element;
      Reference :        Element);
   --  This procedure implements a most complicated case for the fix needed
   --  for BB10-002. It correct the result in the situation when we have nested
   --  generic instantiations, and the named number in question is declared in
   --  template. In this situation the approach based on Original_Entity field
   --  returns the defining name from the template, but we need the defining
   --  name from the outer instantiation (see the test for BB10-002 for more
   --  details)

   function Is_From_Dispatching_Call (Reference : Element) return Boolean;
   --  This function detects if its argument is a name from a dispatching call
   --  for that Corresponding_Name_Definition should return Nil_Element (that
   --  is, a name of a called subprogram or the name of a formal parameter from
   --  a named association)

   function Is_Implicit_Formal_Par (Result_El : Element) return Boolean;
   --  Is supposed to be applied to the result of Identifier_Name_Definition.
   --  Checks if this result corresponds to the situation when the argument of
   --  Identifier_Name_Definition is the reference to a formal parameter from
   --  implicit inherited subprogram

   procedure Correct_Impl_Form_Par
     (Result    : in out Element;
      Reference :        Element);
   --  This procedure is supposed to be called is Result is the result of the
   --  call to Identifier_Name_Definition, and Is_Implicit_Formal_Par yields
   --  True for Result. It creates the correct defining name for this iplicit
   --  inherited formal parameter.

end A4G.Expr_Sem;

Add the ASIS file $i

Add the ASIS file $i


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                          A S I S . C L A U S E S                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (C) 1995-2012, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT 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 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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 ASIS-for-GNAT;  see file --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  AdaCore                   --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

with Asis.Errors;     use Asis.Errors;
with Asis.Exceptions; use Asis.Exceptions;

with Asis.Set_Get;    use  Asis.Set_Get;

with A4G.Mapping;     use A4G.Mapping;
with A4G.Vcheck;      use A4G.Vcheck;

with Atree;           use Atree;
with Namet;           use Namet;
with Nlists;          use Nlists;
with Sinfo;           use Sinfo;
with Snames;          use Snames;

package body Asis.Clauses is

   Package_Name : constant String := "Asis.Clauses.";

   ------------------
   -- Clause_Names --
   ------------------

   function Clause_Names (Clause : Asis.Element) return Asis.Element_List is
      Arg_Kind     : constant Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node     : Node_Id;
      Result_List  : List_Id;
      Result_Len   : Natural := 1;
      Withed_Uname : Node_Id;
   begin
      Check_Validity (Clause, Package_Name & "Clause_Names");

      if not (Arg_Kind = A_Use_Package_Clause  or else
              Arg_Kind = A_Use_Type_Clause     or else
              Arg_Kind = A_Use_All_Type_Clause or else  --  Ada 2012
              Arg_Kind = A_With_Clause)
      then
         Raise_ASIS_Inappropriate_Element
           (Package_Name & "Clause_Names",
            Wrong_Kind => Arg_Kind);
      end if;

      Arg_Node := Node (Clause);

      if Arg_Kind = A_With_Clause then
         --  first, computing the number of names listed in the argument
         --  with clause
         --  Note that we should skip implicit with cleause that may be added
         --  by front-end
         while not (Comes_From_Source (Arg_Node)
                  and then
                    Last_Name (Arg_Node))
         loop
            if Comes_From_Source (Arg_Node) then
               Result_Len := Result_Len + 1;
            end if;

            Arg_Node := Next (Arg_Node);
         end loop;

         declare
            Result_List : Asis.Element_List (1 .. Result_Len);
         begin
            Arg_Node := Node (Clause);

            for I in 1 .. Result_Len loop

               Withed_Uname := Sinfo.Name (Arg_Node);

               Result_List (I) := Node_To_Element_New
                  (Starting_Element => Clause,
                   Node             => Withed_Uname);

               Arg_Node     := Next (Arg_Node);

               while Present (Arg_Node)
                  and then
                     not Comes_From_Source (Arg_Node)
               loop
                  Arg_Node := Next (Arg_Node);
               end loop;

            end loop;

            return Result_List;
         end;
      else

         if Nkind (Arg_Node) = N_Use_Package_Clause then
            Result_List := Names (Arg_Node);
         else
            Result_List := Subtype_Marks (Arg_Node);
         end if;

         return  N_To_E_List_New (List             => Result_List,
                                  Starting_Element => Clause);
      end if;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>

         if Status_Indicator = Unhandled_Exception_Error then
            Add_Call_Information
              (Outer_Call => Package_Name & "Clause_Names",
               Argument   => Clause);
         end if;

         raise;
      when Ex : others =>
         Report_ASIS_Bug
          (Query_Name  => Package_Name & "Clause_Names",
           Ex          => Ex,
           Arg_Element => Clause);
   end Clause_Names;

   -------------------------------
   -- Component_Clause_Position --
   -------------------------------

   function Component_Clause_Position
     (Clause : Asis.Component_Clause)
      return   Asis.Expression
   is
      Arg_Kind : constant Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Clause, Package_Name & "Component_Clause_Position");

      if not (Arg_Kind = A_Component_Clause) then
         Raise_ASIS_Inappropriate_Element
           (Package_Name & "Component_Clause_Position",
            Wrong_Kind => Arg_Kind);
      end if;

      Arg_Node := Node (Clause);

      return Node_To_Element_New (Node             => Position (Arg_Node),
                                  Starting_Element => Clause);

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>

         if Status_Indicator = Unhandled_Exception_Error then
            Add_Call_Information
              (Outer_Call => Package_Name & "Component_Clause_Position",
               Argument   => Clause);
         end if;

         raise;
      when Ex : others =>
         Report_ASIS_Bug
          (Query_Name  => Package_Name & "Component_Clause_Position",
           Ex          => Ex,
           Arg_Element => Clause);
   end Component_Clause_Position;

   ----------------------------
   -- Component_Clause_Range --
   ----------------------------

   function Component_Clause_Range
     (Clause : Asis.Component_Clause)
      return   Asis.Discrete_Range
   is
      Arg_Kind : constant Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Clause, Package_Name & "Component_Clause_Range");

      if not (Arg_Kind = A_Component_Clause) then
         Raise_ASIS_Inappropriate_Element
           (Package_Name & "Component_Clause_Range",
            Wrong_Kind => Arg_Kind);
      end if;

      Arg_Node := Node (Clause);

      return Node_To_Element_New
               (Node             => Arg_Node,
                Internal_Kind    => A_Discrete_Simple_Expression_Range,
                Starting_Element => Clause);

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>

         if Status_Indicator = Unhandled_Exception_Error then
            Add_Call_Information
              (Outer_Call => Package_Name & "Component_Clause_Range",
               Argument   => Clause);
         end if;

         raise;
      when Ex : others =>
         Report_ASIS_Bug
          (Query_Name  => Package_Name & "Component_Clause_Range",
           Ex          => Ex,
           Arg_Element => Clause);
   end Component_Clause_Range;

   -----------------------
   -- Component_Clauses --
   -----------------------

   function Component_Clauses
     (Clause          : Asis.Representation_Clause;
      Include_Pragmas : Boolean := False)
      return            Asis.Component_Clause_List
   is
      Arg_Kind : constant Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Clause, Package_Name & "Component_Clauses");

      if not (Arg_Kind = A_Record_Representation_Clause) then
         Raise_ASIS_Inappropriate_Element
           (Package_Name & "Component_Clauses",
            Wrong_Kind => Arg_Kind);
      end if;

      Arg_Node := Node (Clause);

      return N_To_E_List_New
               (List             => Component_Clauses (Arg_Node),
                Include_Pragmas  => Include_Pragmas,
                Starting_Element => Clause);

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>

         if Status_Indicator = Unhandled_Exception_Error then
            Add_Call_Information
              (Outer_Call => Package_Name & "Component_Clauses",
               Argument   => Clause,
               Bool_Par   => Include_Pragmas);
         end if;

         raise;
      when Ex : others =>
         Report_ASIS_Bug
          (Query_Name  => Package_Name & "Component_Clauses",
           Ex          => Ex,
           Arg_Element => Clause,
           Bool_Par_ON => Include_Pragmas);
   end Component_Clauses;

   ---------------------------
   -- Mod_Clause_Expression --
   ---------------------------

   function Mod_Clause_Expression
     (Clause : Asis.Representation_Clause)
      return   Asis.Expression
   is
      Arg_Kind        : constant Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node        : Node_Id;
      Mod_Clause_Node : Node_Id;
   begin

      Check_Validity (Clause, Package_Name & "Mod_Clause_Expression");

      if not (Arg_Kind = A_Record_Representation_Clause) then
         Raise_ASIS_Inappropriate_Element
           (Package_Name & "Mod_Clause_Expression",
            Wrong_Kind => Arg_Kind);
      end if;

      Arg_Node := Node (Clause);

      Mod_Clause_Node := Next (Arg_Node);

      if Nkind (Mod_Clause_Node) = N_Attribute_Definition_Clause and then
         From_At_Mod (Mod_Clause_Node)
      then
         Mod_Clause_Node := Sinfo.Expression (Mod_Clause_Node);
      else
         Mod_Clause_Node := Empty;
      end if;

      if No (Mod_Clause_Node) then
         return Asis.Nil_Element;
      else
         return Node_To_Element_New
                  (Node             => Mod_Clause_Node,
                   Starting_Element => Clause);
      end if;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>

         if Status_Indicator = Unhandled_Exception_Error then
            Add_Call_Information
              (Outer_Call => Package_Name & "Mod_Clause_Expression",
               Argument   => Clause);
         end if;

         raise;
      when Ex : others =>
         Report_ASIS_Bug
          (Query_Name  => Package_Name & "Mod_Clause_Expression",
           Ex          => Ex,
           Arg_Element => Clause);
   end Mod_Clause_Expression;

   --------------------------------------
   -- Representation_Clause_Expression --
   --------------------------------------

   function Representation_Clause_Expression
     (Clause : Asis.Representation_Clause)
      return   Asis.Expression
   is
      Arg_Kind    : constant Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node    : Node_Id;
      Result_Node : Node_Id;
      Result_Kind : Internal_Element_Kinds := Not_An_Element;
   begin

      Check_Validity (Clause,
                     Package_Name & "Representation_Clause_Expression");

      if not (Arg_Kind = An_Attribute_Definition_Clause       or else
              Arg_Kind = An_Enumeration_Representation_Clause or else
              Arg_Kind = An_At_Clause)
      then
         Raise_ASIS_Inappropriate_Element
           (Package_Name & "Representation_Clause_Expression",
            Wrong_Kind => Arg_Kind);
      end if;

      Arg_Node := Node (Clause);

      if Nkind (Arg_Node) = N_Enumeration_Representation_Clause then
         Result_Node := Array_Aggregate (Arg_Node);

         if Present (Expressions (Result_Node)) then
            Result_Kind := A_Positional_Array_Aggregate;
         else
            Result_Kind := A_Named_Array_Aggregate;
         end if;

      else
         Result_Node := Sinfo.Expression (Arg_Node);
      end if;

      return Node_To_Element_New (Node             => Result_Node,
                                  Internal_Kind    => Result_Kind,
                                  Starting_Element => Clause);

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>

         if Status_Indicator = Unhandled_Exception_Error then
            Add_Call_Information
              (Outer_Call => Package_Name & "Representation_Clause_Expression",
               Argument   => Clause);
         end if;

         raise;
      when Ex : others =>
         Report_ASIS_Bug
          (Query_Name  => Package_Name & "Representation_Clause_Expression",
           Ex          => Ex,
           Arg_Element => Clause);
   end Representation_Clause_Expression;

   --------------------------------
   -- Representation_Clause_Name --
   --------------------------------

   function Representation_Clause_Name
     (Clause : Asis.Clause)
      return   Asis.Name
   is
      Arg_Kind       : constant Internal_Element_Kinds := Int_Kind (Clause);
      Arg_Node       : Node_Id;
      Result_Node    : Node_Id;

      Result_Element : Element;
      Result_Kind    : Internal_Element_Kinds := Not_An_Element;
      Attr_Des       : Name_Id;
      --  needed for special processing of attribute definition clause
   begin

      Check_Validity (Clause, Package_Name & "Representation_Clause_Name");

      if not (Arg_Kind = An_Attribute_Definition_Clause       or else
              Arg_Kind = An_Enumeration_Representation_Clause or else
              Arg_Kind = A_Record_Representation_Clause       or else
              Arg_Kind = An_At_Clause                         or else
              Arg_Kind = A_Component_Clause)
      then
         Raise_ASIS_Inappropriate_Element
           (Package_Name & "Representation_Clause_Name",
            Wrong_Kind => Arg_Kind);
      end if;

      Arg_Node := Node (Clause);

      if Nkind (Arg_Node) = N_Attribute_Definition_Clause then
         --  for An_Attribute_Definition_Clause argument we have to return
         --  as the result the Element of An_Attribute_Reference kind.
         --  The tree does not contain the structures for attribute reference
         --  in this case (and it should not, because, according to RM 95,
         --  there is no attribute reference in the syntax structure of
         --  an attribute definition clause, so we have to "emulate"
         --  the result Elemet of An_Attribute_Reference kind on the base
         --  of the same node

         --  first, we have to define the exact kind of the "artificial"
         --  attribute reference to be returned
         Attr_Des := Chars (Arg_Node);

         case Attr_Des is
            when Name_Address =>
               Result_Kind := An_Address_Attribute;
            when Name_Alignment =>
               Result_Kind := An_Alignment_Attribute;
            when Name_Bit_Order =>
               Result_Kind := A_Bit_Order_Attribute;
            when Name_Component_Size =>
               Result_Kind := A_Component_Size_Attribute;
            when Name_External_Tag =>
               Result_Kind := An_External_Tag_Attribute;
            when Name_Input =>
               Result_Kind := An_Input_Attribute;
            when Name_Machine_Radix =>
               Result_Kind := A_Machine_Radix_Attribute;
            when Name_Output =>
               Result_Kind := An_Output_Attribute;
            when Name_Read =>
               Result_Kind := A_Read_Attribute;
            when Name_Size =>
               Result_Kind := A_Size_Attribute;
            when Name_Small =>
               Result_Kind := A_Small_Attribute;
            when Name_Storage_Size =>
               Result_Kind := A_Storage_Size_Attribute;
            when Name_Storage_Pool =>
               Result_Kind := A_Storage_Pool_Attribute;
            when Name_Write =>
               Result_Kind := A_Write_Attribute;
            when others =>
               --  "others" means Name_Object_Size and Name_Value_Size
               Result_Kind := An_Implementation_Defined_Attribute;
         end case;

         Result_Element := Clause;
         Set_Int_Kind (Result_Element, Result_Kind);

         return Result_Element;

      elsif Nkind (Arg_Node) = N_Component_Clause then
         Result_Node := Component_Name (Arg_Node);
      else
         Result_Node := Sinfo.Identifier (Arg_Node);
      end if;

      return Node_To_Element_New (Node             => Result_Node,
                                  Starting_Element => Clause);

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>

         if Status_Indicator = Unhandled_Exception_Error then
            Add_Call_Information
              (Outer_Call => Package_Name & "Representation_Clause_Name",
               Argument   => Clause);
         end if;

         raise;
      when Ex : others =>
         Report_ASIS_Bug
          (Query_Name  => Package_Name & "Representation_Clause_Name",
           Ex          => Ex,
           Arg_Element => Clause);
   end Representation_Clause_Name;

end Asis.Clauses;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  asf-reoutes-servlets-rest -- Route for the REST API
--  Copyright (C) 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with ASF.Rest;

package ASF.Routes.Servlets.Rest is

   type Descriptor_Array is array (ASF.Rest.Method_Type) of ASF.Rest.Descriptor_Access;

   --  The route has one descriptor for each REST method.
   type API_Route_Type is new ASF.Routes.Servlets.Servlet_Route_Type with record
      Descriptors : Descriptor_Array;
   end record;

end ASF.Routes.Servlets.Rest;

Define the ASF.Routes.Servlets.Rest package for the REST route


-----------------------------------------------------------------------
--  bkp-stores-local -- Store management for local files
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Directories;
with Ada.Strings.Unbounded;
with Ada.Streams.Stream_IO;
with Util.Log.Loggers;
with Util.Files;
with Interfaces;
package body Babel.Stores.Local is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Babel.Stores.Local");

   function Get_File_Size (Ent : in Ada.Directories.Directory_Entry_Type) return Ada.Directories.File_Size is
      Size : Ada.Directories.File_Size;
   begin
      Size := Ada.Directories.Size (Ent);
      return Size;

   exception
      when Constraint_Error =>
         return Ada.Directories.File_Size (Interfaces.Unsigned_32'Last);
   end Get_File_Size;

   --  ------------------------------
   --  Get the absolute path to access the local file.
   --  ------------------------------
   function Get_Absolute_Path (Store : in Local_Store_Type;
                               Path  : in String) return String is
   begin
      if Ada.Strings.Unbounded.Length (Store.Root_Dir) = 0 then
         return Path;
      else
         return Util.Files.Compose (Ada.Strings.Unbounded.To_String (Store.Root_Dir), Path);
      end if;
   end Get_Absolute_Path;

   procedure Read (Store : in out Local_Store_Type;
                   Path  : in String;
                   Into  : in out Babel.Files.Buffers.Buffer) is
      use Ada.Strings.Unbounded;
      use type Ada.Streams.Stream_Element_Offset;

      File     : Ada.Streams.Stream_IO.File_Type;
      Abs_Path : constant String := Store.Get_Absolute_Path (Path);
   begin
      Ada.Streams.Stream_IO.Open (File, Ada.Streams.Stream_IO.In_File, Abs_Path);
      Ada.Streams.Stream_IO.Read (File, Into.Data, Into.Last);
      Ada.Streams.Stream_IO.Close (File);
   end Read;

   procedure Write (Store : in out Local_Store_Type;
                    Path  : in String;
                    Into  : in Babel.Files.Buffers.Buffer) is
      use Ada.Strings.Unbounded;
      use type Ada.Streams.Stream_Element_Offset;

      File     : Ada.Streams.Stream_IO.File_Type;
      Abs_Path : constant String := Store.Get_Absolute_Path (Path);
   begin
      Ada.Streams.Stream_IO.Open (File, Ada.Streams.Stream_IO.Out_File, Abs_Path);
      Ada.Streams.Stream_IO.Write (File, Into.Data (Into.Data'First .. Into.Last));
      Ada.Streams.Stream_IO.Close (File);
   end Write;

   procedure Scan (Store  : in out Local_Store_Type;
                   Path   : in String;
                   Into   : in out Babel.Files.File_Container'Class;
                   Filter : in Babel.Filters.Filter_Type'Class) is
      use Ada.Directories;
      use type Babel.Files.Directory_Vector_Access;

      Search_Filter : constant Ada.Directories.Filter_Type := (Ordinary_File => True,
                                                               Ada.Directories.Directory => True,
                                                               Special_File => False);
      Search   : Search_Type;
      Ent      : Directory_Entry_Type;
      New_File : Babel.Files.File;
      Child    : Babel.Files.Directory;
   begin
      Log.Info ("Scan directory {0}", Path);

      Start_Search (Search, Directory => Path, Pattern => "*", Filter => Search_Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Name : constant String    := Simple_Name (Ent);
            Kind : constant File_Kind := Ada.Directories.Kind (Ent);
         begin
            if Kind = Ordinary_File then
               if Filter.Is_Accepted (Kind, Path, Name) then
                  New_File.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
                  New_File.Size := Get_File_Size (Ent);
                  Into.Add_File (Path, New_File);
               end if;
            elsif Name /= "." and Name /= ".." and Filter.Is_Accepted (Kind, Path, Name) then
--                 if Into.Children = null then
--                    Into.Children := new Babel.Files.Directory_Vector;
--                 end if;
--                 Child.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
--                 Into.Children.Append (Child);
--                 Into.Tot_Dirs := Into.Tot_Dirs + 1;
               Into.Add_Directory (Path, Name);
            end if;
         end;
      end loop;

   exception
      when E : others =>
         Log.Error ("Exception ", E);
   end Scan;

   --  ------------------------------
   --  Set the root directory for the local store.
   --  ------------------------------
   procedure Set_Root_Directory (Store : in out Local_Store_Type;
                                 Path  : in String) is
   begin
      Store.Root_Dir := Ada.Strings.Unbounded.To_Unbounded_String (Path);
   end Set_Root_Directory;

end Babel.Stores.Local;

Store implementation to access files on the host computer