--
-- @filename adadoc_tree.adb
-- @author Julien Burdy & Vincent Decorges
-- @date 10.4.02
-- @brief Give the token to make the tree
-- @brief and the subprograms to generate xml
--
-- History  :
-- Date     Modification               Author
--
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with Ada.Finalization;

package AdaDoc_Tree is

   --The root token of the object hierarchy
   --The object is controlled because we need a destructor for the deallocation
   --in the future
   type Object_Token is abstract new Ada.Finalization.Controlled with
      record
         Line_Number : Natural := 0;
      end record;
   type Object_Token_Ptr is access all Object_Token'Class;

   --For each Token we provide a method to write is xml code
   --
   -- Purpose : Write xml code for the object
   --
   -- in      : Self : the object
   -- in      : File : file to write in
   --
   procedure Put_Xml (Self : in Object_Token; File : in File_Type);

   --For the deallocation of the Object_Token'Class
   procedure Free is new Ada.Unchecked_Deallocation(Object_Token'Class, Object_Token_Ptr);


   --To concatenate token in the parser
   type Dummy_String_Token is new Object_Token with
      record
         Str : Unbounded_String;
      end record;
   type Dummy_String_Token_Ptr is access all Dummy_String_Token'Class;

   --Generic parameter
   type Generic_Para_Token;
   type Generic_Para_Token_Ptr is access all Generic_Para_Token'Class;
   type Generic_Para_Token is new Object_Token with
      record
         Next_Para : Generic_Para_Token_Ptr;
      end record;

   --Discriminant
   type Discriminant_Token;
   type Discriminant_Token_Ptr is access all Discriminant_Token'Class;

   --Generic type parameter
   type Generic_Type_Para_Token is new Generic_Para_Token with
      record
         Name : Unbounded_String;
         Discriminant : Discriminant_Token_Ptr;
         Type_Def : Unbounded_String;
      end record;
   type Generic_Type_Para_Token_Ptr is access all Generic_Type_Para_Token;

   procedure Put_Xml (Self : in Generic_Type_Para_Token; File : in File_Type);

   --Generic package
   type Generic_Package_Token is new Generic_Para_Token with
      record
         Instanciation : Unbounded_String;
      end record;
   type Generic_Package_Token_Ptr is access all Generic_Package_Token;

   procedure Put_Xml (Self : in Generic_Package_Token; File : in File_Type);

   --Package specification
   type Package_Spec_Token is new Object_Token with
      record
         Name : Unbounded_String;
         --Because with can have generic package without parameters
         Is_Generic : Boolean := False;
         Generic_Part : Generic_Para_Token_Ptr;
      end record;
   type Package_Spec_Token_Ptr is access all Package_Spec_Token'Class;

   procedure Put_Xml (Self : in Package_Spec_Token; File : in File_Type);

   --To stock a list of identifier (Ident1, Ident2 ...)
   type Def_ID_S_Token;
   type Def_ID_S_Token_Ptr is access all Def_ID_S_Token'Class;
   type Def_ID_S_Token is new Dummy_String_Token with
      record
         Next_ID : Def_ID_S_Token_Ptr := null;
      end record;

   --
   -- Purpose : Concatanation of a list of identifier
   --
   -- in      : Self : The list to concatanate
   -- return  : An unbounded string
   --
   function Concat (Self : Def_ID_S_Token) return Unbounded_String;




   --Qualifier for object token
   type Qualifier_Type is (Constant_Qualifier, Aliased_Qualifier);
   type Qualifier_Array_Type is array (Qualifier_Type) of Boolean;
   type Object_Qualifier_Token is new Object_Token with
      record
         Qualifier : Qualifier_Array_Type := (others => False);
      end record;
   type Object_Qualifier_Token_Ptr is access all Object_Qualifier_Token'Class;

   --Variable, constant
   type Object_Declaration_Token is new Object_Token with
      record
         Def_ID_S    : Def_ID_S_Token_Ptr;
         Subtype_Def : Unbounded_String;
         Init        : Unbounded_String := Null_Unbounded_String;
         Qualifier   : Object_Qualifier_Token_Ptr;
      end record;
   type Object_Declaration_Token_Ptr is access all Object_Declaration_Token'Class;

   procedure Put_Xml (Self : in Object_Declaration_Token; File : in File_Type);


   --Exception
   type Exception_Declaration_Token is new Object_Token with
      record
         Def_ID_S : Def_ID_S_Token_Ptr;
      end record;

   type Exception_Declaration_Token_Ptr is access all Exception_Declaration_Token'Class;

   procedure Put_Xml (Self : in Exception_Declaration_Token; File : in File_Type);

   --With clause
   type With_Clause_Token is new Object_Token with
      record
         Name_S : Def_ID_S_Token_Ptr;
      end record;

   procedure Put_Xml (Self : in With_Clause_Token; File : in File_Type);

   type With_Clause_Token_Ptr is access all With_Clause_Token'Class;

   --Use clause
   type Use_Clause_Token is new With_Clause_Token with null record;

   type Use_Clause_Token_Ptr is access all Use_Clause_Token'Class;

   --Use type
   type Use_Type_Clause_Token is new With_Clause_Token with null record;
   type Use_Type_Clause_Token_Ptr is access all Use_Type_Clause_Token'Class;

   --Representation Clause
   type Rep_Clause_Token is new Object_Token with
      record
         Def : Unbounded_String;
      end record;
   type Rep_Clause_Token_Ptr is access all Rep_Clause_Token'Class;

   procedure Put_Xml (Self : in Rep_Clause_Token; File : in File_Type);


   --Pragma
   type Pragma_Decl_Token is new Object_Token with
      record
         Name : Unbounded_String;
         Decl : Unbounded_String := Null_Unbounded_String;
      end record;
   type Pragma_Decl_Token_Ptr is access all Pragma_Decl_Token'Class;

   procedure Put_Xml (Self : in Pragma_Decl_Token; File : in File_Type);

   --Mode for Parameters
   type Mode_Type is (In_Mode, Out_Mode, In_Out_Mode, Access_Mode);
   type Mode_Token is new Object_Token with
      record
         Mode : Mode_Type;
      end record;
   type Mode_Token_Ptr is access all Mode_Token'Class;

   function Convert_Mode ( Self : Mode_Token) return String;

   --Parameters
   type Parameters_Token;
   type Parameters_Token_Ptr is access all Parameters_Token'Class;
   type Parameters_Token is new Object_Token with
      record
         Def_ID_S : Def_ID_S_Token_Ptr;
         Mode : Mode_Token_Ptr;
         Type_Param : Unbounded_String;
         Init : Unbounded_String := Null_Unbounded_String;
         Next : Parameters_Token_Ptr := null;
      end Record;

   --
   -- Purpose : Concatanation of a list of parameters
   --
   -- in      : Self : The list to concatanate
   -- return  : An unbounded string
   --
   function Concat (Self : Parameters_Token) return Unbounded_String;
   procedure Put_Xml (Self : in Parameters_Token; File : in File_Type);

   --Subprogram declaration
   type Subprog_Token is new Object_Token with
      record
         Name : Unbounded_String;
         Parameters : Parameters_Token_Ptr;
         Is_Abstract : Boolean := False;
         --Because we can have generic package without parameters
         Is_Generic : Boolean := False;
         Generic_Part : Generic_Para_Token_Ptr;
      end record;
   type Subprog_Token_Ptr is access all Subprog_Token'Class;

   --Procedure declaration
   type Procedure_Decl_Token is new Subprog_Token with null record;
   type Procedure_Decl_Token_Ptr is access all Procedure_Decl_Token'Class;

   procedure Put_Xml (Self : in Procedure_Decl_Token; File : in File_Type);

   --Function declaration
   type Function_Decl_Token is new Subprog_Token with
      record
         Return_Type : Unbounded_String;
      end record;
   type Function_Decl_Token_Ptr is access all Function_Decl_Token'Class;

   procedure Put_Xml (Self : in Function_Decl_Token; File : in File_Type);

   --Generic subprogram declaration
   type Generic_Subp_Para_Token is new Generic_Para_Token with
      record
         Name : Unbounded_String;
         Parameters : Parameters_Token_Ptr;
         Subp_Default : Unbounded_String := Null_Unbounded_String;
      end record;
   type Generic_Subp_Para_Token_Ptr is access all Generic_Type_Para_Token;

   --Generic procedure parameter
   type Generic_Proc_Para_Token is new Generic_Subp_Para_Token with null record;
   type Generic_Proc_Para_Token_Ptr is access all Generic_Proc_Para_Token;

   procedure Put_Xml (Self : in Generic_Proc_Para_Token; File : in File_Type);

   --Generic function parameter
   type Generic_Fun_Para_Token is new Generic_Subp_Para_Token with
      record
         Return_Type : Unbounded_String;
      end record;
   type Generic_Fun_Para_Token_Ptr is access all Generic_Fun_Para_Token;

   procedure Put_Xml (Self : in Generic_Fun_Para_Token; File : in File_Type);


   --Not a generic type but a general type for the tree
   type Generic_Type_Token is new Object_Token with
      record
         Name : Unbounded_String;
      end record;
   type Generic_Type_Token_Ptr is access all Generic_Type_Token'Class;

   --Generic type discriminant
   type Generic_Discrimant_Type_Token is new Generic_Type_Token with
      record
         Discriminant_Part : Discriminant_Token_Ptr;
      end record;
   type Generic_Discrimant_Type_Token_Ptr is access all Generic_Discrimant_Type_Token;

   --Simple type
   type Simple_Type_Token is new Generic_Discrimant_Type_Token with
      record
         Declaration_Part : Unbounded_String;
      end record;
   type Simple_Type_Token_Ptr is access all Simple_Type_Token'Class;

   procedure Put_Xml (Self : in Simple_Type_Token; File : in File_Type);

   --Derived type
   type Derived_Type_Token is new Generic_Discrimant_Type_Token with
      record
         Declaration_Part : Unbounded_String;
         Inheritance : Unbounded_String;
      end record;
   type Derived_Type_Token_Ptr is access all Derived_Type_Token'Class;

   procedure Put_Xml (Self : in Derived_Type_Token; File : in File_Type);

   -- For the record

   --Record Component
   type Component_Token;
   type Component_Token_Ptr is access all Component_Token'Class;
   type Component_Token is new Object_Token with
      record
         Def_ID_S    : Def_ID_S_Token_Ptr;
         Type_Def    : Unbounded_String;
         Init        : Unbounded_String;
         Next_Component : Component_Token_Ptr;
      end record;

   procedure Put_Xml (Self : in Component_Token; File : in File_Type);

   --Record Discriminant
   type Discriminant_Token is new Component_Token with null record;

   --
   -- Purpose : Concatanation of a list of discriminant
   --
   -- in      : Self : The list to concatanate
   -- return  : An unbounded string
   --
   function Concat (Self : in Discriminant_Token) return Unbounded_String;

   type Component_List_Token;
   type Component_List_Token_Ptr is access all Component_List_Token;

   --Component record for variant choice
   type Variant_Choice_Token;
   type Variant_Choice_Token_Ptr is access all Variant_Choice_Token;
   type Variant_Choice_Token is new Object_Token with
      record
         Choice : Unbounded_String;
         Component_List : Component_List_Token_Ptr;
         Next_Variant_Choice : Variant_Choice_Token_Ptr;
      end record;

   procedure Put_Xml (Self : in Variant_Choice_Token; File : in File_Type);

   --Variant record
   type Variant_Token;
   type Variant_Token_Ptr is access all Variant_Token;
   type Variant_Token is new Object_Token with
      record
         Discriminant : Unbounded_String;
         Choice : Variant_Choice_Token_Ptr;
      end record;

   procedure Put_Xml (Self : in Variant_Token; File : in File_Type);

   --A record is composed of component (optional) and
   -- of variant part (optional)
   type Component_List_Token is new Object_Token with
      record
         Component_Part : Component_Token_Ptr;
         Variant_Part : Variant_Token_Ptr;
      end record;


   procedure Put_Xml (Self : in Component_List_Token; File : in File_Type);

   --Tagged record
   type Poo_Record_Token is new Object_Token with
      record
         Inheritance : Unbounded_String := Null_Unbounded_String;
         Is_Limited : Boolean := False;
         Is_Abstract : Boolean := False;
      end record;
   type Poo_Record_Token_Ptr is access all Poo_Record_Token;

   --Record type
   type Record_Type_Token is new Generic_Discrimant_Type_Token with
      record
         Component_List : Component_List_Token_Ptr;
         Poo_Part : Poo_Record_Token_Ptr;
         Null_Record : Boolean := False;
      end record;
   type Record_Type_Token_Ptr is access all Record_Type_Token'Class;

   procedure Put_Xml (Self : in Record_Type_Token; File : File_Type);

   --Subtype
   type Subtype_Decl_Token is new Simple_Type_Token with null record;
   type Subtype_Decl_Token_Ptr is access all Subtype_Decl_Token;


   procedure Put_Xml (Self : in Subtype_Decl_Token; File : in File_Type);

   --Generic package instanciation
   type Generic_Pkg_Inst_Token is new Object_Token with
      record
         Instanciation : Unbounded_String;
      end record;
   type Generic_Pkg_Inst_Token_Ptr is access all Generic_Pkg_Inst_Token;

   procedure Put_Xml (Self : in Generic_Pkg_Inst_Token; File : in File_Type);

   --Generic subprogram instanciation
   type Generic_Subp_Inst_Token is new Generic_Pkg_Inst_Token with
      record
         Subprog_Spec : Subprog_Token_Ptr;
      end record;
   type Generic_Subp_Inst_Token_Ptr is access all Generic_Subp_Inst_Token;

   procedure Put_Xml (Self : in Generic_Subp_Inst_Token; File : File_Type);

   --Generic parameter
   type Generic_Param_Token is new Generic_Para_Token with
      record
         Def_ID_S : Def_ID_S_Token_Ptr;
         Mode : Mode_Token_Ptr;
         Type_Param : Unbounded_String;
         Init : Unbounded_String;
      end record;
   type Generic_Param_Token_Ptr is access all Generic_Param_Token;

   procedure Put_Xml ( Self : in Generic_Param_Token; File : in File_Type);

   --Write to xml a list of generic object
   procedure Put_Xml (Node : in Generic_Para_Token_Ptr; File : File_Type);

   --For Task
   type Entry_Decl_Token;
   type Entry_Decl_Token_Ptr is access all Entry_Decl_Token'Class;
   type Entry_Decl_Token is new Subprog_Token with
      record
         Family : Unbounded_String := Null_Unbounded_String;
      end record;

   procedure Put_Xml (Self : in Entry_Decl_Token; File : in File_Type);

   type Entry_Decl_List;
   type Entry_Decl_List_Ptr is access all Entry_Decl_List'Class;
   type Entry_Decl_List is new Entry_Decl_Token with
      record
         Next : Entry_Decl_List_Ptr;
      end record;

   procedure Put_Xml (Self : in Entry_Decl_List_Ptr; File : in File_Type);

   type Task_Decl_Token is new Object_Token with
      record
         Name : Unbounded_String;
         Discriminant : Discriminant_Token_Ptr;
         Entries : Entry_Decl_List_Ptr;
         Private_Entries : Entry_Decl_List_Ptr;
      end record;
   type Task_Decl_Token_Ptr is access all Task_Decl_Token'Class;

   procedure Put_Xml (Self : in Task_Decl_Token; File : in File_Type);

   type Task_Type_Decl_Token is new Task_Decl_Token with null record;
   type Task_Type_Decl_Token_Ptr is access all Task_Type_Decl_Token'Class;

   type Protected_Object_List;
   type Protected_Object_List_Ptr is access all Protected_Object_List'Class;
   type Protected_Object_List is new Object_Token with
      record
         --Could be procedure, function or entry
         Item : Subprog_Token_Ptr;
         Next : Protected_Object_List_Ptr;
      end record;

   procedure Put_Xml (Self : in Protected_Object_List_Ptr; File : in File_Type);

   type Protected_Private_Object_List is new Protected_Object_List with
      record
         --List of private component
         Private_Comp : Component_Token_Ptr;
      end record;
   type Protected_Private_Object_List_Ptr is access all
        Protected_Private_Object_List'Class;

   procedure Put_Xml (Self : in Protected_Private_Object_List_Ptr; File : in File_Type);

   type Protected_Decl_Token is new Object_Token with
      record
         Name : Unbounded_String;
         Discriminant : Discriminant_Token_Ptr;
         Prot_Op      : Protected_Object_List_Ptr;
         Prot_Op_Private : Protected_Private_Object_List_Ptr;
      end record;

   type Protected_Decl_Token_Ptr is access all Protected_Decl_Token'Class;
   procedure Put_Xml (Self : in Protected_Decl_Token; File : in File_Type);

   type Protected_Type_Decl_Token is new Protected_Decl_Token with null record;
   type Protected_Type_Decl_Token_Ptr is access all Protected_Type_Decl_Token'Class;


   --Renames
   type Renames_Decl_Token is abstract new Object_Token with
      record
         Rename : Unbounded_String;
      end record;
   type Renames_Decl_Token_Ptr is access all Renames_Decl_Token'Class;

   type Renames_Exception_Token is new Renames_Decl_Token with
      record
         Def_ID_S : Def_ID_S_Token_Ptr;
      end record;
   type Renames_Exception_Token_Ptr is access all Renames_Exception_Token'Class;

   procedure Put_Xml (Self : in Renames_Exception_Token; File : in File_Type);

   type Renames_Object_Token is new Renames_Exception_Token with
      record
         Qualifier : Object_Qualifier_Token_Ptr;
         Subtype_Ind : Unbounded_String;
      end record;
   type Renames_Object_Token_Ptr is access all Renames_Object_Token'Class;

   procedure Put_Xml (Self : in Renames_Object_Token; File : in File_Type);

   type Renames_Package_Token is new Renames_Decl_Token with
      record
         Name : Unbounded_String;
      end record;

   type Renames_Package_Token_Ptr is access all Renames_Package_Token'Class;

   procedure Put_Xml (Self : in Renames_Package_Token; File : in File_Type);

   type Renames_Generic_Package_Token is new Renames_Package_Token with null record;
   procedure Put_Xml (Self : in Renames_Generic_Package_Token; File : in File_Type);

   type Renames_Generic_Package_Token_Ptr is access all
   Renames_Generic_Package_Token'Class;

   type Renames_Subp_Token is new Renames_Decl_Token with
      record
         Subprog_Spec : Subprog_Token_Ptr;
      end record;
   type Renames_Subp_Token_Ptr is access all Renames_Subp_Token'Class;
   procedure Put_Xml (Self : in Renames_Subp_Token; File : in File_Type);

   type Renames_Generic_Subp_Token is new Renames_Subp_Token with null record;
   type Renames_Generic_Subp_Token_Ptr is access all Renames_Generic_Subp_Token'Class;
   procedure Put_Xml (Self : in Renames_Generic_Subp_Token; File : in File_Type);

end AdaDoc_Tree;



   