aws_24.0.0_2b75fe6d/templates_parser/src/templates_parser.adb

------------------------------------------------------------------------------
--                             Templates Parser                             --
--                                                                          --
--                     Copyright (C) 1999-2022, AdaCore                     --
--                                                                          --
--  This library is free software;  you can redistribute it and/or modify   --
--  it under terms of the  GNU General Public License  as published by the  --
--  Free Software  Foundation;  either version 3,  or (at your  option) any --
--  later version. This library is distributed in the hope that it will be  --
--  useful, but WITHOUT ANY WARRANTY;  without even the implied warranty of --
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                    --
--                                                                          --
--  As a special exception under Section 7 of GPL version 3, you are        --
--  granted additional permissions described in the GCC Runtime Library     --
--  Exception, version 3.1, as published by the Free Software Foundation.   --
--                                                                          --
--  You should have received a copy of the GNU General Public License and   --
--  a copy of the GCC Runtime Library Exception along with this program;    --
--  see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see   --
--  <http://www.gnu.org/licenses/>.                                         --
--                                                                          --
--  As a special exception, if other files instantiate generics from this   --
--  unit, or you link this unit with other files to produce an executable,  --
--  this  unit  does not  by itself cause  the resulting executable to be   --
--  covered by the GNU General Public License. This exception does not      --
--  however invalidate any other reasons why the executable file  might be  --
--  covered by the  GNU Public License.                                     --
------------------------------------------------------------------------------

pragma Ada_2012;

with Ada.Calendar;
with Ada.Characters.Handling;
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Containers.Indefinite_Vectors;
with Ada.Exceptions;
with Ada.IO_Exceptions;
with Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants;
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;

with GNAT.Calendar.Time_IO;
with GNAT.Regpat;

with Templates_Parser.Configuration;
with Templates_Parser.Input;
with Templates_Parser.Utils;

package body Templates_Parser is

   use Ada.Exceptions;
   use Ada.Strings;

   Internal_Error : exception;

   Blank : constant Maps.Character_Set := Maps.To_Set (' ' & ASCII.HT);

   function Get_Parameters (Parameters : String) return Parameter_Set;
   --  Returns the parameters set as parsed into Parameters. This routines
   --  handles both positional and named parameters. It is currently used for
   --  include and macro parameters.

   --------------
   -- Tag Info --
   --------------

   Begin_Tag : Unbounded_String := To_Unbounded_String (Default_Begin_Tag);
   End_Tag   : Unbounded_String := To_Unbounded_String (Default_End_Tag);

   Set_Token                  : constant String := "@@SET@@";
   Table_Token                : constant String := "@@TABLE@@";
   Terminate_Sections_Token   : constant String := "@@TERMINATE_SECTIONS@@";
   Begin_Token                : constant String := "@@BEGIN@@";
   End_Token                  : constant String := "@@END@@";
   Section_Token              : constant String := "@@SECTION@@";
   End_Table_Token            : constant String := "@@END_TABLE@@";
   Macro_Token                : constant String := "@@MACRO@@";
   End_Macro_Token            : constant String := "@@END_MACRO@@";
   If_Token                   : constant String := "@@IF@@";
   Elsif_Token                : constant String := "@@ELSIF@@";
   Else_Token                 : constant String := "@@ELSE@@";
   End_If_Token               : constant String := "@@END_IF@@";
   Include_Token              : constant String := "@@INCLUDE@@";
   Extends_Token              : constant String := "@@EXTENDS@@";
   End_Extends_Token          : constant String := "@@END_EXTENDS@@";
   Block_Token                : constant String := "@@BLOCK@@";
   End_Block_Token            : constant String := "@@END_BLOCK@@";
   Inline_Token               : constant String := "@@INLINE@@";
   End_Inline_Token           : constant String := "@@END_INLINE@@";
   A_Terminate_Sections_Token : constant String := "TERMINATE_SECTIONS";
   A_Reverse_Token            : constant String := "REVERSE";
   A_Terse_Token              : constant String := "TERSE";
   A_Aligh_On                 : constant String := "ALIGN_ON";

   ------------
   -- Filter --
   ------------

   package Filter is

      ----------------------
      --  Filters setting --
      ----------------------

      --  A filter appear just before a tag variable (e.g. @_LOWER:SOME_VAR_@
      --  and means that the filter LOWER should be applied to SOME_VAR before
      --  replacing it in the template file.

      type Mode is
        (Multiply,
         --  Multiply the given parameter to the string (operator "*")

         Plus,
         --  Add the given parameter to the string (operator "+")

         Minus,
         --  Substract the given parameter to the string (operator "-")

         Divide,
         --  Divide the given parameter to the string (operator "/")

         Absolute,
         --  Returns the abosulte value

         Add,
         --  Add the given parameter to the string

         Add_Param,
         --  Add an HTTP parameter to the string, add the '&' parameter
         --  separator if needed.

         Alternate,
         --  Returns parameter if value is not null

         BR_2_EOL,
         --  Replaces all <BR> HTML tags by a given end-of-line sequence

         BR_2_LF,
         --  Replaces all <BR> HTML tags by LF characters

         Capitalize,
         --  Lower case except char before spaces and underscores

         Clean_Text,
         --  Only letter/digits all other chars are changed to spaces

         Coma_2_Point,
         --  Replaces comas by points

         Contract,
         --  Replaces a suite of spaces by a single space character

         Default,
         --  Returns parameter if value is empty

         Del_Param,
         --  Delete an HTTP parameter from the string, removes the '&'
         --  Parameter separator if needed.

         Div,
         --  Divide the given parameter to the string

         Exist,
         --  Returns "TRUE" if var is not empty and "FALSE" otherwise

         File_Exists,
         --  Returns "TRUE" if var is the name of an existing file and "FALSE"
         --  otherwise.

         Format_Date,
         --  Returns the date formatted using the format parameter. This
         --  format is following the GNU/date as implemented in
         --  GNAT.Calendar.Time_IO. The date must be in the ISO format
         --  YYYY-MM-DD eventually followed by a space and the time with the
         --  format HH:MM:SS. So the string must be either 10 or 19 characters
         --  long.

         Format_Number,
         --  Returns the number with a space added between each 3 digits
         --  blocks. The decimal part is not transformed. If the data is not a
         --  number nothing is done. The data is trimmed before processing it.

         Is_Empty,
         --  Returns "TRUE" if var is empty and "FALSE" otherwise

         LF_2_BR,
         --  Replaces all LF character to <BR> HTML tag

         Lower,
         --  Lower case

         Match,
         --  Returns "TRUE" if var match the pattern passed as argument

         Max,
         --  Returns the max between the filter parameter and the value

         Min,
         --  Returns the min between the filter parameter and the value

         Modulo,
         --  Returns current value modulo N (N is the filter parameter)

         Mult,
         --  Multiply the given parameter to the string

         Neg,
         --  Change the size of the value

         No_Digit,
         --  Replace all digits by spaces

         No_Dynamic,
         --  This is a command filter, it indicates that the variable even if
         --  not found in the translation table will not be looked up into the
         --  dynamic context (Lazy_Tag). This filter just returns the string
         --  as-is.

         No_Letter,
         --  Removes all letters by spaces

         No_Space,
         --  Removes all spaces found in the value

         Oui_Non,
         --  If True return Oui, If False returns Non, else do nothing

         Point_2_Coma,
         --  Replaces points by comas

         Repeat,
         --  Returns N copy of the original string. The number of copy is
         --  passed as parameter.

         Replace,
         --  Replaces part of the string using a regultar expression. This is
         --  equivalent to the well known "s/<regexp>/<new value>/" sed
         --  command. It replaces only the first match.

         Replace_All,
         --  Idem as above, but replace all matches. This equivalent to the
         --  well known "s/<regexp>/<new value>/g" sed command.

         Replace_Param,
         --  Idem as @_ADD_PARAM(key=value):DEL_PARAM(key):VAR_@

         Invert,
         --  Reverse string

         Size,
         --  Returns the number of characters in the string value

         Slice,
         --  Returns a slice of the string

         Strip,
         --  Trim leading and trailing spaces and characters HT, LF, CR, NUL

         Sub,
         --  Substract the given parameter to the string

         Trim,
         --  Trim leading and trailing space

         Upper,
         --  Upper case

         User_Defined,
         --  A user's defined filter

         Web_Encode,
         --  Idem as Web_Escape and also encode non 7-bit ASCII characters as
         --  &#xxx;.

         Web_Escape,
         --  Convert characters <>&" to HTML equivalents: &lt;, &gt; and &amp;
         --  and &quot;

         Web_NBSP,
         --  Convert spaces to HTML &nbsp; - non breaking spaces

         Wrap,
         --  Wrap lines longer than a given number of characters

         Yes_No
         --  If True return Yes, If False returns No, else do nothing
        );

      type User_CB_Type is (With_Param, No_Param, As_Tagged);
      type User_CB (Typ : User_CB_Type := With_Param) is record
         case Typ is
            when With_Param  => CBP : Callback;
            when No_Param    => CB  : Callback_No_Param;
            when As_Tagged   => CBT : User_Filter_Access;
         end case;
      end record;

      type Parameter_Mode is (Str, Regexp, Regpat, Slice, User_Callback);

      function Parameter (Mode : Filter.Mode) return Parameter_Mode;
      --  Returns the parameter mode for the given filter

      type Pattern_Matcher_Access is access GNAT.Regpat.Pattern_Matcher;

      type Parameter_Data (Mode : Parameter_Mode := Slice) is record
         case Mode is
            when Str =>
               S : Unbounded_String;

            when Regexp =>
               R_Str   : Unbounded_String;
               Regexp  : Pattern_Matcher_Access;

            when Regpat =>
               P_Str   : Unbounded_String;
               Regpat  : Pattern_Matcher_Access;
               Param   : Unbounded_String;

            when Slice =>
               First   : Integer;
               Last    : Integer;

            when User_Callback =>
               Handler : User_CB;
               P       : Unbounded_String;
         end case;
      end record;

      No_Parameter : constant Parameter_Data := Parameter_Data'(Slice, 0, -1);

      function Image (P : Parameter_Data) return String;
      --  Returns parameter string representation

      procedure Release (P : in out Parameter_Data) with Inline;
      --  Release all memory allocated P

      type Filter_Context (P_Size : Natural) is record
         Translations : Translate_Set;
         Lazy_Tag     : Dynamic.Lazy_Tag_Access;
         I_Parameters : Parameter_Set (1 .. P_Size);
      end record;

      type Callback is access function
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;
      --  P is the filter parameter, no parameter by default. Parameter are
      --  untyped and will be parsed by the filter function if needed.

      type Routine is record
         Handle     : Callback;
         Parameters : Parameter_Data;
      end record;

      type Set is array (Positive range <>) of Routine;
      type Set_Access is access Set;

      procedure Release (S : in out Set);
      --  Release all memory allocated P

      type String_Access is access constant String;

      type Filter_Record is record
         Name   : String_Access;
         Handle : Callback;
      end record;

      --  User's filter

      procedure Register
        (Name    : String;
         Handler : Templates_Parser.Callback);

      procedure Register
        (Name    : String;
         Handler : Callback_No_Param);

      procedure Register
        (Name    : String;
         Handler : not null access User_Filter'Class);

      procedure Free_Filters;

      function User_Handle (Name : String) return User_CB;
      --  Returns the registered user's callback for the given filter name

      --  filter functions, see above

      procedure Check_Null_Parameter (P : Parameter_Data);
      --  Raises Template_Error if P is not equal to Null_Parameter

      function Absolute
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Add_Param
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Alternate
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function BR_2_EOL
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function BR_2_LF
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Capitalize
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Clean_Text
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Coma_2_Point
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Contract
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Default
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Del_Param
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Exist
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function File_Exists
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Format_Date
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Format_Number
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Is_Empty
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function LF_2_BR
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Lower
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Match
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Max
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Min
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Neg
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function No_Digit
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function No_Dynamic
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function No_Letter
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function No_Space
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Oui_Non
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Point_2_Coma
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Repeat
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Replace
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Replace_All
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Replace_Param
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Reverse_Data
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Size
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Slice
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Strip
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Trim
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Upper
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function User_Defined
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Web_Encode
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Web_Escape
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Web_NBSP
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Wrap
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Yes_No
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Plus
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Minus
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Divide
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Multiply
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Modulo
        (S : String;
         C : not null access Filter_Context;
         P : Parameter_Data := No_Parameter) return String;

      function Handle (Name : String) return Callback;
      --  Returns the filter function for the given filter name

      function Handle (Mode : Filter.Mode) return Callback;
      --  Returns the filter function for the given filter mode

      function Mode_Value (Name : String) return Mode;
      --  Returns the Mode for filter named Name. This is the internal
      --  representation for this filter name.

      function Name (Handle : Callback) return String;
      --  Returns the filter name for the given filter function

      function Is_No_Dynamic (Filters : Set_Access) return Boolean;
      --  Returns True if Filters contains NO_CONTEXT

   end Filter;

   ---------------
   -- Main tree --
   ---------------

   type Node;
   type Tree is access Node;

   ----------
   -- Data --
   ----------

   package Data is

      type Node;
      type Tree is access Node;

      type NKind is (Text, Var);

      type Attribute is
        (Nil, Length, Line, Min_Column, Max_Column, Up_Level, Indent);

      type Internal_Tag
        is (No, Now, Year, Month, Month_Name, Day, Day_Name, Hour, Minute,
            Second, Number_Line, Table_Line, Table_Level, Up_Table_Line);

      type Attribute_Data is record
         Attr  : Attribute := Nil;
         Value : Integer;
      end record;

      No_Attribute : constant Attribute_Data := (Nil, 0);

      type Parameter_Set is array (Natural range <>) of Tree;
      type Parameters is access all Parameter_Set;

      type Tag_Var is record
         Name       : Unbounded_String;
         Filters    : Filter.Set_Access;
         Attribute  : Attribute_Data;
         N          : Integer;           -- Include variable index
         Internal   : Internal_Tag;      -- No if not an internal variable
         Is_Macro   : Boolean := False;  -- True if this is a macro call
         Parameters : Data.Parameters;
         Def        : Templates_Parser.Tree;
      end record;

      type Node (Kind : NKind) is record
         Next : Tree;
         Line : Natural;
         Col  : Positive; -- first character position in the line
         case Kind is
            when Text =>
               Value : Unbounded_String;
            when Var =>
               Var   : Tag_Var;
         end case;
      end record;

      function Is_Include_Variable (T : Tag_Var) return Boolean with Inline;
      --  Returns True if T is an include variable (Name is $<n>)

      function To_Data_Parameters
        (Parameters : Templates_Parser.Parameter_Set) return Data.Parameters;
      --  Returns Parameters as a Data.Tree set

      function Build (Str : String) return Tag_Var;
      --  Create a Tag from Str. A tag is composed of a name and a set of
      --  filters.

      function Image (T : Tag_Var) return String;
      --  Returns string representation for the Tag variable

      function Translate
        (T       : Tag_Var;
         Value   : String;
         Context : not null access Filter.Filter_Context) return String;
      --  Returns the result of Value after applying all filters for tag T

      procedure Release (T : in out Tag_Var);
      --  Release all memory associated with Tag

      procedure Unchecked_Free is
        new Ada.Unchecked_Deallocation (Parameter_Set, Parameters);

      function Parse (Content : String; Line : Natural) return Tree;
      --  Parse text line and returns the corresponding tree representation

      procedure Print_Tree (D : Tree);
      --  Decend the text tree and print it to the standard output

      procedure Release (D : in out Tree; Single : Boolean := False);
      --  Release all memory used by the tree or only the pointed node if
      --  Single is set to True.

      function Clone (D : Tree) return Tree;
      --  Returns a Clone of D

      function Clone (V : Tag_Var) return Tag_Var;
      --  Returns a Clone of V

   end Data;

   -----------------
   -- Definitions --
   -----------------

   package Definitions is

      type NKind is (Const, Ref, Ref_Default);

      type Node (Kind : NKind := Const) is record
         Value : Unbounded_String;
         Ref   : Positive;
      end record;

      type Def is record
         Name : Unbounded_String;
         N    : Node;
      end record;

      type Tree is access Def;

      function Parse (Line : String) return Tree;
      --  Returns a defintion data

      package Def_Map is new Containers.Indefinite_Hashed_Maps
        (String, Node, Ada.Strings.Hash, "=", "=");
      subtype Map is Def_Map.Map;

      procedure Print_Tree (D : Tree);
      --  Decend the text tree and print it to the standard output

      procedure Release (D : in out Tree);
      --  Release all memory used by the tree

      function Clone (D : Tree) return Tree;
      --  Returns a Clone of D

   end Definitions;

   ------------------
   --  Expressions --
   ------------------

   package Expr is

      type Ops is (O_And, O_Or, O_Xor, O_Cat,
                   O_Sup, O_Inf, O_Esup, O_Einf, O_Equal, O_Diff, O_In);

      function Image (O : Ops) return String;
      --  Returns Ops string representation

      type U_Ops is (O_Not);

      function Image (O : U_Ops) return String;
      --  Returns U_Ops string representation

      type Node;
      type Tree is access Node;

      type NKind is (Value, Var, Op, U_Op);
      --  The node is a value, a variable a binary operator or an unary
      --  operator.

      type Node (Kind : NKind) is record
         Line : Natural;

         case Kind is
            when Value =>
               V : Unbounded_String;

            when Var =>
               Var : Data.Tag_Var;

            when Op =>
               O           : Ops;
               Left, Right : Tree;

            when U_Op =>
               U_O  : U_Ops;
               Next : Tree;
         end case;
      end record;

      function Is_True (Str : String) return Boolean with Inline;
      --  Return True if Str is one of "TRUE" or "T", the test is not
      --  case sensitive.

      function Parse (Expression : String; Line : Natural) return Tree;
      --  Parse Expression and returns the corresponding tree representation

      procedure Print_Tree (E : Tree);
      --  Decend the expression's tree and print the expression. It outputs the
      --  expression with all parenthesis to show without ambiguity the way the
      --  expression has been parsed.

      procedure Release (E : in out Tree; Single : Boolean := False);
      --  Release all associated memory with the tree

      function Clone (E : Tree) return Tree;
      --  Returns a Clone of E

      Unknown : constant String := "*";
      --  Value returned when the expression cannot be determined statically

      function Analyze (E : Expr.Tree) return String;
      --  Static analysis of expresssion E, returns TRUE, FALSE or value
      --  Unknown if the value cannot be determined statically (some variables
      --  are in the expression).

   end Expr;

   --------------------------------
   --  Template Tree definitions --
   --------------------------------

   type Nkind is (Info,          --  first node is tree infos
                  C_Info,        --  second node is cache tree info
                  Text,          --  this is a text line
                  Set_Stmt,      --  a definition statement
                  If_Stmt,       --  an IF tag statement
                  Table_Stmt,    --  a TABLE tag statement
                  Section_Block, --  a TABLE block (common, section)
                  Section_Stmt,  --  a TABLE section
                  Include_Stmt,  --  an INCLUDE tag statement
                  Extends_Stmt,  --  an EXTENDS tag statement
                  Block_Stmt,    --  a BLOCK tag statement
                  Inline_Stmt);  --  an INLINE tag statement

   --  A template line is coded as a suite of Data and Var elements

   --  The first node in the tree is of type Info and should never be release
   --  and changed. This ensure that included tree will always be valid
   --  otherwise will would have to parse all the current trees in the cache
   --  to update the reference.
   --
   --  Static_Tree represent a Tree immune to cache changes. Info point to the
   --  first node and C_Info to the second one. C_Info could be different to
   --  Info.Next in case of cache changes. This way we keep a pointer to the
   --  old tree to be able to release it when not used anymore. This way it is
   --  possible to use the cache in multitasking program without trouble. The
   --  changes in the cache are either because more than one task is parsing
   --  the same template at the same time, they will update the cache with the
   --  same tree at some point, or because a newer template was found in the
   --  file system.

   type Static_Tree is record
      Info   : Tree;
      C_Info : Tree;
   end record;

   Null_Static_Tree : constant Static_Tree := (null, null);

   package Tree_Map is new Containers.Indefinite_Hashed_Maps
     (String, Tree, Strings.Hash, "=", "=");

   type Included_File_Info is record
      File     : Static_Tree;
      Filename : Data.Tree;
      Params   : Data.Parameters;
   end record;

   package String_Set is new Containers.Indefinite_Vectors (Positive, String);

   type Node (Kind : Nkind) is record
      Next : Tree;
      Line : Natural;

      case Kind is
         when Info =>
            Filename  : Unbounded_String;         -- Name of the file
            Timestamp : Configuration.Time_Stamp; -- Date/Time of last change

            I_File    : Tree;
            --  Included file references; Nodes are Include_Stmt or
            --  Extends_Stmt

         when C_Info =>
            Obsolete  : Boolean := False;    -- True if newer version in cache
            Used      : Natural := 0;        -- >0 if currently used

         when Text =>
            Text      : Data.Tree;

         when Set_Stmt =>
            Def       : Definitions.Tree;

         when If_Stmt =>
            Cond      : Expr.Tree;
            N_True    : Tree;
            N_False   : Tree;

         when Extends_Stmt =>
            N_Extends  : Tree;  --  The BLOCK children
            E_Included : Included_File_Info;  --  Extended file

         when Block_Stmt =>
            B_Name    : Unbounded_String;
            N_Block   : Tree;

         when Table_Stmt =>
            Terminate_Sections : Boolean;
            Reverse_Index      : Boolean;
            Terse              : Boolean;
            Align_On           : String_Set.Vector;
            Blocks             : Tree;
            Blocks_Count       : Natural;     -- Number if blocks

         when Section_Block =>
            Common         : Tree;
            Sections       : Tree;
            Sections_Count : Natural;         -- Number of sections

         when Section_Stmt =>
            N_Section : Tree;

         when Include_Stmt =>
            I_Included : Included_File_Info;

         when Inline_Stmt =>
            Before  : Unbounded_String;
            Sep     : Unbounded_String;
            After   : Unbounded_String;
            I_Block : Tree;
      end case;
   end record;

   procedure Release (T : in out Tree; Include : Boolean := True);
   --  Release all memory associated with the tree

   function Clone (T : Tree) return Tree;
   --  Returns a Clone of T

   procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Node, Tree);

   -------------------
   --  Cached Files --
   -------------------

   --  Cached_Files keep the parsed Tree for a given file in memory. This
   --  package has two implementations one is thread safe so it is possible to
   --  use the cache in a multitasking program. The other is meant to be used
   --  for configuration that do not want to drag the tasking runtime.

   package Cached_Files is

      procedure Add
        (Filename : String;
         T        : Tree;
         Old      : out Tree);
      --  Add Filename/T to the list of cached files. If Filename is
      --  already in the list, replace the current tree with T. Furthermore
      --  if Filename tree is already in use, Old will be set with the
      --  previous C_Info node otherwise Old will be T.Next (C_Info node
      --  for current tree).

      procedure Get
        (Filename : String;
         Result   : out Static_Tree);
      --  Returns the Tree for Filename or Null_Static_Tree if Filename has
      --  not been cached or is obsolete.

      procedure Release (T : in out Static_Tree);
      --  After loading a tree and using it, it is required that it be
      --  released. This will ensure that a tree marked as obsolete (a new
      --  version being now in the cache) will be released from the memory.

      procedure Release;
      --  Release the internal cache. This free the memory used for all
      --  currently loaded template trees.

   end Cached_Files;

   -----------
   -- Macro --
   -----------

   package Macro is

      procedure Register (Name : String; T : not null Tree);
      --  Register a new macro definition, if previous definition exists,
      --  replace with the new definition.

      function Get (Name : String) return Tree;
      --  Get macro tree, returns null if this macro has no definition

      procedure Rewrite
        (T          : in out Tree;
         Parameters : not null access Data.Parameter_Set);
      --  Rewrite the macro tree with the given parameters. All @_1_@
      --  parameters in the macro definition are replaced with the
      --  corresponding value in the parameter set.

      procedure Print_Defined_Macros;
      --  Print the defined macros (for debug purpose)

      Callback : Macro_Callback;

   end Macro;

   ----------------
   -- Simplifier --
   ----------------

   package Simplifier is

      procedure Run (T : in out Tree);
      --  Execute a tree simplifier pass, removes statically known IF branch
      --  and merges all consecutive TEXT node.

   end Simplifier;

   ---------
   -- Tag --
   ---------

   procedure Field
     (T      : Tag;
      N      : Positive;
      Result : out Tag_Node_Access;
      Found  : out Boolean);
   --  Returns the Nth item in Tag

   procedure Field
     (T        : Tag;
      Cursor   : Indices;
      Up_Value : Natural;
      Result   : out Unbounded_String;
      Found    : out Boolean);
   --  Returns Value in Tag at position Cursor. Found is set to False if
   --  there is no such value in Tag.

   function No_Quote (Str : String) return String;
   --  Removes quotes around Str. If Str (Str'First) and Str (Str'Last)
   --  are quotes return Str (Str'First + 1 ..  Str'Last - 1) otherwise
   --  return Str as-is.

   function Quote (Str : String) return String;
   --  Returns Str quoted if it contains spaces, otherwise just returns Str

   function Is_Number (S : String) return Boolean with Inline;
   --  Returns True if S is a decimal number

   procedure Unchecked_Free is
     new Ada.Unchecked_Deallocation (Integer, Integer_Access);

   procedure Unchecked_Free is
     new Unchecked_Deallocation (Tag_Node_Arr, Tag_Node_Arr_Access);

   function Build_Include_Pathname
     (Filename, Include_Filename : String) return String;
   --  Returns the full pathname to the include file (Include_Filename). It
   --  returns Include_Filename if there is a pathname specified, or the
   --  pathname of the main template file as a prefix of the include
   --  filename.

   function Load
     (Filename     : String;
      Cached       : Boolean := False;
      Include_File : Boolean := False) return Static_Tree;
   --  Load a template file and returns the semantic tree. The template file is
   --  cached if Cached is set to true. If cached next Load will use the
   --  preparsed tree.

   procedure Print_Tree (T : Tree; Level : Natural := 0);
   --  Print the semantic tree, this is mostly for debugging purpose

   ---------
   -- "&" --
   ---------

   function "&" (T : Tag; Value : String) return Tag is
      Item : constant Tag_Node_Access :=
               new Tag_Node'
                 (Templates_Parser.Value, null,
                  V => To_Unbounded_String (Value));
   begin
      T.Ref_Count.all := T.Ref_Count.all + 1;

      Unchecked_Free (T.Data.Tag_Nodes);

      if T.Data.Head = null then
         T.Data.all :=
           (T.Data.Count + 1,
            Min          => Natural'Min (T.Data.Min, 1),
            Max          => Natural'Max (T.Data.Max, 1),
            Nested_Level => 1,
            Separator    => To_Unbounded_String (Default_Separator),
            Head         => Item,
            Last         => Item,
            Tag_Nodes    => null,
            Values       => null);

         return (Ada.Finalization.Controlled with T.Ref_Count, Data => T.Data);

      else
         T.Data.Last.Next := Item;
         T.Data.all :=
           (T.Data.Count + 1,
            Min          => Natural'Min (T.Data.Min, 1),
            Max          => Natural'Max (T.Data.Max, 1),
            Nested_Level => T.Data.Nested_Level,
            Separator    => T.Data.Separator,
            Head         => T.Data.Head,
            Last         => Item,
            Tag_Nodes    => null,
            Values       => null);

         return (Ada.Finalization.Controlled with T.Ref_Count, Data => T.Data);
      end if;
   end "&";

   function "&" (Value : String; T : Tag) return Tag is
      Item : constant Tag_Node_Access :=
               new Tag_Node'
                 (Templates_Parser.Value, T.Data.Head,
                  V => To_Unbounded_String (Value));
   begin
      T.Ref_Count.all := T.Ref_Count.all + 1;

      Unchecked_Free (T.Data.Tag_Nodes);

      if T.Data.Head = null then
         T.Data.all :=
           (T.Data.Count + 1,
            Min          => Natural'Min (T.Data.Min, 1),
            Max          => Natural'Max (T.Data.Max, 1),
            Nested_Level => 1,
            Separator    => To_Unbounded_String (Default_Separator),
            Head         => Item,
            Last         => Item,
            Tag_Nodes    => null,
            Values       => null);

         return (Ada.Finalization.Controlled with T.Ref_Count, T.Data);

      else
         T.Data.all :=
           (T.Data.Count + 1,
            Min          => Natural'Min (T.Data.Min, 1),
            Max          => Natural'Max (T.Data.Max, 1),
            Nested_Level => T.Data.Nested_Level,
            Separator    => T.Data.Separator,
            Head         => Item,
            Last         => T.Data.Last,
            Tag_Nodes    => null,
            Values       => null);

         return (Ada.Finalization.Controlled with T.Ref_Count, T.Data);
      end if;
   end "&";

   function "&" (T : Tag; Value : Tag) return Tag is
      Item   : constant Tag_Node_Access :=
                 new Tag_Node'(Value_Set, null, new Tag'(Value));
      T_Size : constant Natural := Size (Value);
   begin
      T.Ref_Count.all := T.Ref_Count.all + 1;

      Unchecked_Free (T.Data.Tag_Nodes);

      if T.Data.Head = null then
         T.Data.all :=
           (T.Data.Count + 1,
            Min          => Natural'Min (T.Data.Min, T_Size),
            Max          => Natural'Max (T.Data.Max, T_Size),
            Nested_Level => Value.Data.Nested_Level + 1,
            Separator    => To_Unbounded_String ((1 => ASCII.LF)),
            Head         => Item,
            Last         => Item,
            Tag_Nodes    => null,
            Values       => null);

         return (Ada.Finalization.Controlled with T.Ref_Count, T.Data);

      else
         T.Data.Last.Next := Item;

         T.Data.all :=
           (T.Data.Count + 1,
            Min          => Natural'Min (T.Data.Min, T_Size),
            Max          => Natural'Max (T.Data.Max, T_Size),
            Nested_Level =>
              Positive'Max
                (T.Data.Nested_Level, Value.Data.Nested_Level + 1),
            Separator    => T.Data.Separator,
            Head         => T.Data.Head,
            Last         => Item,
            Tag_Nodes    => null,
            Values       => null);

         return (Ada.Finalization.Controlled with T.Ref_Count, T.Data);
      end if;
   end "&";

   function "&" (T : Tag; Value : Character) return Tag is
   begin
      return T & String'(1 => Value);
   end "&";

   function "&" (T : Tag; Value : Boolean) return Tag is
   begin
      return T & Boolean'Image (Value);
   end "&";

   function "&" (T : Tag; Value : Unbounded_String) return Tag is
   begin
      return T & To_String (Value);
   end "&";

   function "&" (T : Tag; Value : Integer) return Tag is
   begin
      return T & Utils.Image (Value);
   end "&";

   function "&" (Value : Character; T : Tag) return Tag is
   begin
      return String'(1 => Value) & T;
   end "&";

   function "&" (Value : Boolean; T : Tag) return Tag is
   begin
      return Boolean'Image (Value) & T;
   end "&";

   function "&" (Value : Unbounded_String; T : Tag) return Tag is
   begin
      return To_String (Value) & T;
   end "&";

   function "&" (Value : Integer; T : Tag) return Tag is
   begin
      return Utils.Image (Value) & T;
   end "&";

   function "&"
     (Left : Association; Right : Association) return Translate_Set
   is
      T : Translate_Set;
   begin
      Insert (T, Left);
      Insert (T, Right);
      return T;
   end "&";

   function "&"
     (Set : Translate_Set; Item : Association) return Translate_Set
   is
      T : Translate_Set := Set;
   begin
      Insert (T, Item);
      return T;
   end "&";

   ---------
   -- "+" --
   ---------

   function "+" (Value : String) return Tag is
      Item : constant Tag_Node_Access :=
               new Tag_Node'(Templates_Parser.Value,
                             null,
                             V => To_Unbounded_String (Value));
   begin
      return (Ada.Finalization.Controlled with
              Ref_Count    => new Integer'(1),
              Data         => new Tag_Data'
                (Count        => 1,
                 Min          => 1,
                 Max          => 1,
                 Nested_Level => 1,
                 Separator    => To_Unbounded_String (Default_Separator),
                 Head         => Item,
                 Last         => Item,
                 Tag_Nodes    => null,
                 Values       => null));
   end "+";

   function "+" (Value : Character) return Tag is
   begin
      return +String'(1 => Value);
   end "+";

   function "+" (Value : Boolean) return Tag is
   begin
      return +Boolean'Image (Value);
   end "+";

   function "+" (Value : Unbounded_String) return Tag is
   begin
      return +To_String (Value);
   end "+";

   function "+" (Value : Integer) return Tag is
   begin
      return +Utils.Image (Value);
   end "+";

   function "+" (Value : Tag) return Tag is
      Result : Tag;
   begin
      Result := Result & Value;
      --  This is an embedded tag, set separator to LF
      Set_Separator (Result, (1 => ASCII.LF));
      return Result;
   end "+";

   function "+" (Item : Association) return Translate_Set is
      T : Translate_Set;
   begin
      Insert (T, Item);
      return T;
   end "+";

   ------------
   -- Adjust --
   ------------

   overriding procedure Adjust (Set : in out Translate_Set) is
   begin
      Templates_Parser_Tasking.Lock;

      if Set.Ref_Count = null then
         --  This is a not yet initialized null set. This case happens when
         --  assigning Null_Set to a Translate_Set variable for example.
         Initialize (Set);

      else
         Set.Ref_Count.all := Set.Ref_Count.all + 1;
      end if;

      Templates_Parser_Tasking.Unlock;
   end Adjust;

   overriding procedure Adjust (T : in out Tag) is
   begin
      Templates_Parser_Tasking.Lock;
      T.Ref_Count.all := T.Ref_Count.all + 1;
      Templates_Parser_Tasking.Unlock;
   end Adjust;

   ------------
   -- Append --
   ------------

   procedure Append (T : in out Tag; Value : Tag) is
      Item   : constant Tag_Node_Access :=
                 new Tag_Node'(Value_Set, null, new Tag'(Value));
      T_Size : constant Natural := Size (Value);
   begin
      if T.Data.Head = null then
         T.Data.Nested_Level := Value.Data.Nested_Level + 1;
         T.Data.Separator    := To_Unbounded_String ((1 => ASCII.LF));
         T.Data.Head         := Item;
      else
         T.Data.Last.Next := Item;
         T.Data.Nested_Level :=
           Positive'Max
             (T.Data.Nested_Level, Value.Data.Nested_Level + 1);
      end if;

      Unchecked_Free (T.Data.Tag_Nodes);
      T.Data.Tag_Nodes := null;
      T.Data.Count     := T.Data.Count + 1;
      T.Data.Min       := Natural'Min (T.Data.Min, T_Size);
      T.Data.Max       := Natural'Max (T.Data.Max, T_Size);
      T.Data.Last      := Item;
   end Append;

   procedure Append (T : in out Tag; Value : Unbounded_String) is
      Item : constant Tag_Node_Access :=
               new Tag_Node'(Templates_Parser.Value, null, Value);
   begin
      if T.Data.Head = null then
         T.Data.Head         := Item;
         T.Data.Nested_Level := 1;
         T.Data.Separator    := To_Unbounded_String (Default_Separator);

      else
         T.Data.Last.Next := Item;
      end if;

      Unchecked_Free (T.Data.Tag_Nodes);
      T.Data.Tag_Nodes := null;
      T.Data.Count     := T.Data.Count + 1;
      T.Data.Min       := Natural'Min (T.Data.Min, 1);
      T.Data.Max       := Natural'Max (T.Data.Max, 1);
      T.Data.Last      := Item;
   end Append;

   procedure Append (T : in out Tag; Value : String) is
   begin
      Append (T, To_Unbounded_String (Value));
   end Append;

   procedure Append (T : in out Tag; Value : Character) is
   begin
      Append (T, To_Unbounded_String (String'(1 => Value)));
   end Append;

   procedure Append (T : in out Tag; Value : Boolean) is
   begin
      Append (T, To_Unbounded_String (Boolean'Image (Value)));
   end Append;

   procedure Append (T : in out Tag; Value : Integer) is
   begin
      Append (T, To_Unbounded_String (Utils.Image (Value)));
   end Append;

   -----------
   -- Assoc --
   -----------

   function Assoc
     (Variable : String;
      Value    : String) return Association is
   begin
      return Association'
        (Std,
         Variable => To_Unbounded_String (Variable),
         Value    => To_Unbounded_String (Value));
   end Assoc;

   function Assoc
     (Variable : String;
      Value    : Ada.Strings.Unbounded.Unbounded_String)
      return Association is
   begin
      return Assoc (Variable, To_String (Value));
   end Assoc;

   function Assoc
     (Variable : String;
      Value    : Integer) return Association is
   begin
      return Assoc (Variable, Utils.Image (Value));
   end Assoc;

   function Assoc
     (Variable : String;
      Value    : Boolean) return Association is
   begin
      if Value then
         return Assoc (Variable, "TRUE");
      else
         return Assoc (Variable, "FALSE");
      end if;
   end Assoc;

   function Assoc
     (Variable  : String;
      Value     : Tag;
      Separator : String := Default_Separator) return Association
   is
      T : Tag := Value;
   begin
      if Separator /= Default_Separator then
         Set_Separator  (T, Separator);
      end if;

      return Association'
        (Composite,
         Variable   => To_Unbounded_String (Variable),
         Comp_Value => T);
   end Assoc;

   ----------------------------
   -- Build_Include_Pathname --
   ----------------------------

   function Build_Include_Pathname
     (Filename, Include_Filename : String) return String
   is
      Dir_Seps : constant Maps.Character_Set := Maps.To_Set ("/\");
   begin
      if Include_Filename'Length > 1
        and then Maps.Is_In
          (Include_Filename (Include_Filename'First), Dir_Seps)
      then
         --  Include filename is an absolute path, return it without the
         --  leading directory separator.
         return Include_Filename
           (Include_Filename'First + 1 .. Include_Filename'Last);

      elsif Include_Filename'Length > 2
        and then Include_Filename (Include_Filename'First) = '.'
        and then Maps.Is_In
          (Include_Filename (Include_Filename'First + 1), Dir_Seps)
      then
         return Include_Filename;

      else
         declare
            K : constant Natural :=
                  Fixed.Index (Filename, Dir_Seps, Going => Strings.Backward);
         begin
            if K = 0 then
               return Include_Filename;
            else
               return Filename (Filename'First .. K) & Include_Filename;
            end if;
         end;
      end if;
   end Build_Include_Pathname;

   ------------------
   -- Cached_Files --
   ------------------

   package body Cached_Files is separate;

   -----------
   -- Macro --
   -----------

   package body Macro is separate;

   ----------------
   -- Simplifier --
   ----------------

   package body Simplifier is separate;

   -----------
   -- Clear --
   -----------

   procedure Clear (T : in out Tag) is
      NT : Tag;
   begin
      --  Here we just separate current vector from the new one
      T := NT;
   end Clear;

   -----------
   -- Clone --
   -----------

   function Clone (T : Tree) return Tree is
      procedure Clone (Included : in out Included_File_Info);
      --  Clone the fields in Included

      procedure Clone (Included : in out Included_File_Info) is
      begin
         Included.Filename := Data.Clone (Included.Filename);
         Included.Params :=
           new Data.Parameter_Set'(Included.Params.all);
         for K in Included.Params'Range loop
            Included.Params (K) := Data.Clone (Included.Params (K));
         end loop;
      end Clone;

      N : Tree;
   begin
      if T /= null then
         N := new Node'(T.all);

         case N.Kind is
            when Text =>
               N.Text := Data.Clone (N.Text);

            when Info =>
               N.I_File := Clone (N.I_File);

            when If_Stmt =>
               N.Cond := Expr.Clone (N.Cond);
               N.N_True := Clone (N.N_True);
               N.N_False := Clone (N.N_False);

            when Table_Stmt =>
               N.Blocks := Clone (N.Blocks);

            when Extends_Stmt =>
               N.N_Extends := Clone (N.N_Extends);
               Clone (N.E_Included);

            when Block_Stmt =>
               N.N_Block := Clone (N.N_Block);

            when Section_Block =>
               N.Common := Clone (N.Common);
               N.Sections := Clone (N.Sections);

            when Section_Stmt =>
               N.N_Section := Clone (N.N_Section);

            when Inline_Stmt =>
               N.I_Block := Clone (N.I_Block);

            when Set_Stmt =>
               N.Def := Definitions.Clone (N.Def);

            when Include_Stmt =>
               Clone (N.I_Included);

            when C_Info =>
               null;
         end case;

         N.Next := Clone (N.Next);
      end if;

      return N;
   end Clone;

   ---------------
   -- Composite --
   ---------------

   function Composite (T : Tag; N : Positive) return Tag is
      Result : Tag;
      Found  : Boolean;
   begin
      Field (T, N, Result, Found);

      if Found then
         return Result;
      else
         raise Constraint_Error;
      end if;
   end Composite;

   ----------
   -- Data --
   ----------

   package body Data is separate;

   -----------------
   -- Definitions --
   -----------------

   package body Definitions is separate;

   ------------
   -- Exists --
   ------------

   function Exists
     (Set : Translate_Set; Variable : String) return Boolean is
   begin
      return Set.Set.Contains (Variable);
   end Exists;

   ----------
   -- Expr --
   ----------

   package body Expr is separate;

   -----------
   -- Field --
   -----------

   procedure Field
     (T      : Tag;
      N      : Positive;
      Result : out Tag_Node_Access;
      Found  : out Boolean) is
   begin
      Found := True;

      --  First check that the array access is present

      if T.Data.Tag_Nodes = null then
         T.Data.Tag_Nodes := new Tag_Node_Arr (1 .. T.Data.Count);

         declare
            P : Tag_Node_Access := T.Data.Head;
         begin
            for K in T.Data.Tag_Nodes'Range loop
               T.Data.Tag_Nodes (K) := P;
               P := P.Next;
            end loop;
         end;
      end if;

      if N > T.Data.Count then
         --  No such item for this position
         Result := null;
         Found  := False;

      else
         Result := T.Data.Tag_Nodes (N);
      end if;
   end Field;

   procedure Field
     (T      : Tag;
      N      : Positive;
      Result : out Tag;
      Found  : out Boolean)
   is
      R : Tag_Node_Access;
   begin
      Field (T, N, R, Found);

      if Found and then R.Kind = Value_Set then
         --  There is a Tag at this position, return it
         Result := R.VS.all;
      else
         Found := False;
      end if;
   end Field;

   procedure Field
     (T        : Tag;
      Cursor   : Indices;
      Up_Value : Natural;
      Result   : out Unbounded_String;
      Found    : out Boolean)
   is

      function Image (T : Tag) return Unbounded_String;
      --  Returns T string representation

      -----------
      -- Image --
      -----------

      function Image (T : Tag) return Unbounded_String is

         function Image (N : Tag_Node) return Unbounded_String;
         --  Returns N string representation

         -----------
         -- Image --
         -----------

         function Image (N : Tag_Node) return Unbounded_String is
         begin
            if N.Kind = Value then
               return N.V;
            else
               return Image (N.VS.all);
            end if;
         end Image;

         Result : Unbounded_String;
         N      : Tag_Node_Access := T.Data.Head;
      begin
         while N /= null loop
            if Result /= Null_Unbounded_String then
               Append (Result, T.Data.Separator);
            end if;
            Append (Result, Image (N.all));
            N := N.Next;
         end loop;
         return Result;
      end Image;

      C       : Natural := 0;
      P       : Natural := 0;
      R       : Tag_Node_Access;
      Inlined : Boolean := False;
   begin
      Found := True;

      if Cursor'Length <= Up_Value then
         --  The current cursor length is smaller than the up_level attribute
         --  in this case we just inline the tag.
         Inlined := True;

      elsif Cursor'Length > T.Data.Nested_Level then
         C := Cursor'Last - T.Data.Nested_Level + 1 - Up_Value;
         P := Cursor (C);

      elsif Cursor'Length /= 0 then
         C := Cursor'First;
         P := Cursor (C);
      end if;

      if Inlined then
         Result := Image (T);

      else
         Field (T, P, R, Found);
      end if;

      if R /= null then
         --  We have found something at this indice

         if C + Up_Value = Cursor'Last then
            --  This is the last position

            if R.Kind = Value then
               --  Found a leaf, just return the value
               Result := R.V;
            else
               Result := Image (R.VS.all);
            end if;

         else
            --  There is more position to look for in the cursor

            if R.Kind = Value then
               --  This is a leaf, there is nothing more to look for
               Found  := False;
               Result := Null_Unbounded_String;

            else
               --  Look into next dimension
               Field
                 (R.VS.all,
                  Cursor (C + 1 .. Cursor'Last), Up_Value,
                  Result, Found);
            end if;
         end if;

      else
         Found := False;
      end if;
   end Field;

   ------------
   -- Filter --
   ------------

   package body Filter is separate;

   --------------
   -- Finalize --
   --------------

   overriding procedure Finalize (Set : in out Translate_Set) is
      procedure Unchecked_Free is new Unchecked_Deallocation
        (Association_Map.Map, Map_Access);
      Ref_Count : Integer_Access := Set.Ref_Count;
   begin
      --  Ensure call is idempotent

      Set.Ref_Count := null;

      if Ref_Count /= null then
         Templates_Parser_Tasking.Lock;
         Ref_Count.all := Ref_Count.all - 1;

         if Ref_Count.all = 0 then
            Unchecked_Free (Ref_Count);
            Unchecked_Free (Set.Set);
         end if;
         Templates_Parser_Tasking.Unlock;
      end if;
   end Finalize;

   overriding procedure Finalize (T : in out Tag) is
      Ref_Count : Integer_Access := T.Ref_Count;
   begin
      --  Ensure call is idempotent

      T.Ref_Count := null;

      if Ref_Count /= null then
         Templates_Parser_Tasking.Lock;

         Ref_Count.all := Ref_Count.all - 1;

         if Ref_Count.all = 0 then
            Templates_Parser_Tasking.Unlock;

            declare
               procedure Unchecked_Free is new Ada.Unchecked_Deallocation
                 (Tag_Node, Tag_Node_Access);

               procedure Unchecked_Free is new Ada.Unchecked_Deallocation
                 (Tag, Tag_Access);

               procedure Unchecked_Free is new Ada.Unchecked_Deallocation
                 (Tag_Data, Tag_Data_Access);

               procedure Unchecked_Free is new Ada.Unchecked_Deallocation
                 (Tag_Values.Set, Tag_Values_Access);

               P, N : Tag_Node_Access;
            begin
               P := T.Data.Head;

               while P /= null loop
                  N := P.Next;

                  if P.Kind = Value_Set then
                     Unchecked_Free (P.VS);
                  end if;

                  Unchecked_Free (P);

                  P := N;
               end loop;

               T.Data.Head := null;
               T.Data.Last := null;

               Unchecked_Free (Ref_Count);
               Unchecked_Free (T.Data.Tag_Nodes);
               Unchecked_Free (T.Data.Values);
               Unchecked_Free (T.Data);
            end;

         else
            Templates_Parser_Tasking.Unlock;
         end if;
      end if;
   end Finalize;

   ---------------------------
   -- For_Every_Association --
   ---------------------------

   procedure For_Every_Association (Set : Translate_Set) is
      Pos  : Association_Map.Cursor;
      Quit : Boolean := False;
   begin
      Pos := Set.Set.First;

      while Association_Map.Has_Element (Pos) loop
         Action (Association_Map.Element (Pos), Quit);
         exit when Quit;
         Pos := Association_Map.Next (Pos);
      end loop;
   end For_Every_Association;

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

   function Get
     (Set  : Translate_Set;
      Name : String) return Association
   is
      Pos : Association_Map.Cursor;
   begin
      Pos := Set.Set.all.Find (Name);

      if Association_Map.Has_Element (Pos) then
         return Association_Map.Element (Pos);
      else
         return Null_Association;
      end if;
   end Get;

   function Get (Assoc : Association) return Tag is
   begin
      if Assoc.Kind = Composite then
         return Assoc.Comp_Value;
      else
         raise Constraint_Error;
      end if;
   end Get;

   function Get (Assoc : Association) return String is
   begin
      if Assoc.Kind = Std then
         return To_String (Assoc.Value);
      else
         raise Constraint_Error;
      end if;
   end Get;

   --------------------
   -- Get_Parameters --
   --------------------

   function Get_Parameters
     (Parameters : String) return Parameter_Set
   is
      function Get (Count : Natural) return Parameter_Set;
      --  Load the Count parameters from Parameters string

      function Next (Char : Character; From : Positive) return Natural;
      --  Returns the position of the next character Char starting from
      --  position From. Returns 0 if the character is not found. This routine
      --  skips characters inside quoted string.

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

      function Get (Count : Natural) return Parameter_Set is

         procedure Get_Named_Parameters (Parameters : String);
         --  Load parameters specified with a name:
         --  (param_a, 5 => param_b, 3 => param_c)
         --  Set Result variable accordingly.

         procedure Get_Next_Parameter
           (Parameters : String;
            First      : in out Positive;
            Last       :    out Natural;
            Next_Last  :    out Natural);
         --  Look for next parameter starting at position First, set First and
         --  Last to the index of this parameter. Next_Last is set to the next
         --  value to assigned to last.

         Result      : Parameter_Set (1 .. Count);
         Index       : Positive := Result'First;
         First, Last : Natural := 0;
         Next_Last   : Natural;

         --------------------------
         -- Get_Named_Parameters --
         --------------------------

         procedure Get_Named_Parameters (Parameters : String) is

            procedure Parse (Parameter : String);
            --  Parse one parameter

            Named       : Boolean := False;
            First, Last : Natural;

            -----------
            -- Parse --
            -----------

            procedure Parse (Parameter : String) is
               Sep : constant Natural := Strings.Fixed.Index (Parameter, "=>");
               Ind : Natural;
            begin
               if Sep = 0 then
                  --  A positional parameter, this is valid only if we have not
                  --  yet found a named parameter.

                  if Named then
                     raise Internal_Error with
                       "Can't have a positional parameter after a named one";
                  else
                     Result (Index) := To_Unbounded_String (Parameter);
                     Index := Index + 1;
                  end if;

               else
                  --  A named parameter, get index
                  Named := True;

                  declare
                     Ind_Str     : constant String :=
                                     Strings.Fixed.Trim
                                       (Parameter (Parameter'First .. Sep - 1),
                                        Strings.Both);
                     First, Last : Natural;
                     Next_Last   : Natural;
                  begin
                     if Is_Number (Ind_Str) then
                        Ind := Natural'Value (Ind_Str);

                        if Result (Ind) = Null_Unbounded_String then
                           --  This parameter has not yet been found

                           First := Sep + 2;

                           Get_Next_Parameter
                             (Parameter, First, Last, Next_Last);

                           Result (Ind) :=
                             To_Unbounded_String (Parameter (First .. Last));

                        else
                           raise Internal_Error with
                             "Parameter" & Natural'Image (Ind)
                             & " defined multiple time";
                        end if;

                     else
                        raise Internal_Error
                          with "Wrong number in named parameter";
                     end if;
                  end;
               end if;
            end Parse;

         begin
            if Parameters (Parameters'Last) /= ')' then
               raise Internal_Error with
                 "Missing closing parenthesis in named include parameters";
            end if;

            First := Parameters'First + 1;
            --  Skip the parenthesis

            loop
               Last := Strings.Fixed.Index
                 (Parameters (First .. Parameters'Last), ",");
               exit when Last = 0;

               Parse
                 (Strings.Fixed.Trim
                    (Parameters (First .. Last - 1), Strings.Both));
               First := Last + 1;
            end loop;

            --  Handle last parameter

            Parse
              (Strings.Fixed.Trim
                 (Parameters (First .. Parameters'Last - 1), Strings.Both));
         end Get_Named_Parameters;

         ------------------------
         -- Get_Next_Parameter --
         ------------------------

         procedure Get_Next_Parameter
           (Parameters : String;
            First      : in out Positive;
            Last       :    out Natural;
            Next_Last  :    out Natural) is
         begin
            --  Skip blanks

            while First < Parameters'Last
              and then (Parameters (First) = ' '
                        or else Parameters (First) = ASCII.HT)
            loop
               First := First + 1;
            end loop;

            --  Look for end of parameter

            Next_Last := First + 1;

            if Parameters (First) = '"' then
               --  Look for closing quote
               while Next_Last < Parameters'Last
                 and then Parameters (Next_Last) /= '"'
               loop
                  Next_Last := Next_Last + 1;
               end loop;

               if Parameters (Next_Last) /= '"' then
                  raise Internal_Error
                    with "Missing closing quote in include parameters";
               end if;

               --  Skip quotes

               First := First + 1;
               Last := Next_Last - 1;

            else
               --  Look for end of word

               while Next_Last < Parameters'Last
                 and then Parameters (Next_Last) /= ' '
                 and then Parameters (Next_Last) /= ASCII.HT
               loop
                  Next_Last := Next_Last + 1;
               end loop;

               if Next_Last /= Parameters'Last then
                  Last := Next_Last - 1;
               else
                  Last := Next_Last;
               end if;
            end if;
         end Get_Next_Parameter;

      begin
         First := Parameters'First;

         while First <= Parameters'Last loop
            --  Skip blanks

            while First < Parameters'Last
              and then (Parameters (First) = ' '
                        or else Parameters (First) = ASCII.HT)
            loop
               First := First + 1;
            end loop;

            --  Check if parameters are specified with a name

            if Index = 1 and then Parameters (First) = '(' then
               --  Stop current processing, load as named parameters
               Get_Named_Parameters (Parameters (First .. Parameters'Last));
               return Result;
            end if;

            Get_Next_Parameter (Parameters, First, Last, Next_Last);

            Result (Index) := To_Unbounded_String (Parameters (First .. Last));
            Index := Index + 1;

            Last := Next_Last;
            First := Last + 1;
         end loop;

         return Result;
      end Get;

      ----------
      -- Next --
      ----------

      function Next (Char : Character; From : Positive) return Natural is
         In_Quote : Boolean := False;
         Index    : Natural := 0;
      begin
         for K in From .. Parameters'Last loop
            if Parameters (K) = '"' then
               In_Quote := not In_Quote;

            elsif Parameters (K) = Char and then not In_Quote then
               Index := K;
               exit;
            end if;
         end loop;
         return Index;
      end Next;

      Count : Natural := 0;
      Index : Natural := Parameters'First - 1;

   begin
      --  Count parameters

      if Parameters'First <= Parameters'Last then
         Count := 1;

         if Parameters (Parameters'First) = '(' then
            --  We are using the parentherized form with parameters separated
            --  with coma and possibly using the named notation.

            --  Count positional parameters

            loop
               Index := Next (',', Index + 1);
               exit when Index = 0;
               Count := Count + 1;
            end loop;

            --  Then check for named ones

            declare
               SP, EP : Natural;
               Sep    : Natural := Parameters'First;
            begin
               loop
                  Sep := Strings.Fixed.Index (Parameters, "=>", From => Sep);
                  exit when Sep = 0;

                  EP := Sep - 1;

                  --  Skip spaces

                  while EP > Parameters'First
                    and then Parameters (EP) = ' '
                  loop
                     EP := EP - 1;
                  end loop;

                  SP := EP;

                  --  Get number

                  while SP > Parameters'First
                    and then Strings.Maps.Is_In
                      (Parameters (SP - 1),
                       Strings.Maps.Constants.Decimal_Digit_Set)
                  loop
                     SP := SP - 1;
                  end loop;

                  if Parameters (EP) in '0' .. '9' then
                     Count := Natural'Max
                       (Count, Natural'Value (Parameters (SP .. EP)));
                  end if;

                  Sep := Sep + 1;
               end loop;
            end;

         else
            --  We are using the standard form, parameters are separated by
            --  spaces.

            loop
               Index := Next (' ', Index + 1);
               exit when Index = 0;

               --  Skip multiple spaces

               while Index < Parameters'Last
                 and then Parameters (Index + 1) = ' '
               loop
                  Index := Index + 1;
               end loop;

               Count := Count + 1;
            end loop;
         end if;
      end if;

      return Get (Count);
   end Get_Parameters;

   ----------------
   -- Initialize --
   ----------------

   overriding procedure Initialize (Set : in out Translate_Set) is
   begin
      Set.Ref_Count := new Integer'(1);
      Set.Set       := new Association_Map.Map;
   end Initialize;

   overriding procedure Initialize (T : in out Tag) is
   begin
      T.Ref_Count         := new Integer'(1);
      T.Data              := new Tag_Data;
      T.Data.Count        := 0;
      T.Data.Min          := Natural'Last;
      T.Data.Max          := 0;
      T.Data.Nested_Level := 1;
   end Initialize;

   ------------
   -- Insert --
   ------------

   procedure Insert (Set : in out Translate_Set; Item : Association) is
   begin
      Set.Set.Include (To_String (Item.Variable), Item);
   end Insert;

   procedure Insert (Set : in out Translate_Set; Items : Translate_Set) is
      Pos : Association_Map.Cursor;
   begin
      if Items.Set = null then
         return;
      end if;

      Pos := Items.Set.First;

      while Association_Map.Has_Element (Pos) loop
         Insert (Set, Association_Map.Element (Pos));
         Pos := Association_Map.Next (Pos);
      end loop;
   end Insert;

   ---------------
   -- Is_Number --
   ---------------

   function Is_Number (S : String) return Boolean is
      use Strings.Maps;
   begin
      return S'Length > 0
        and then Is_Subset
          (To_Set (S), Constants.Decimal_Digit_Set or To_Set ("-"));
   end Is_Number;

   ----------
   -- Item --
   ----------

   function Item (T : Tag; N : Positive) return String is
      Result : Unbounded_String;
      Found  : Boolean;
   begin
      Field (T, (1 => N), 0, Result, Found);

      if not Found then
         raise Constraint_Error;
      else
         return To_String (Result);
      end if;
   end Item;

   ----------
   -- Load --
   ----------

   function Load
     (Filename     : String;
      Cached       : Boolean := False;
      Include_File : Boolean := False) return Static_Tree
   is
      File   : Input.File_Type;     --  file beeing parsed

      Buffer : String (1 .. 2_048); --  current line content
      Last   : Natural;             --  index of last characters read in buffer
      First  : Natural;             --  first non blank characters in buffer

      Line   : Natural := 0;

      I_File : Tree;                --  list of includes

      Error_Include_Message : Unbounded_String;
      --  Message as reported while parsing the include file

      --  Line handling

      procedure Fatal_Error (Message : String) with No_Return;
      --  raise Template_Error exception with message

      function Get_Next_Line return Boolean;
      --  Get new line in File and set Buffer, Last and First. Returns True if
      --  end of file reached.

      function Get_First_Parameter return Unbounded_String;
      --  Get first parameter in current line (second word), words being
      --  separated by a set of blank characters (space or horizontal
      --  tabulation).

      function Get_All_Parameters
        (At_Least_One : Boolean := True) return String;
      --  Get all parameters on the current line

      function Get_Tag_Attributes_Count return Natural;
      --  Returns the number of tag attributes present

      function Get_Tag_Attribute (N : Positive) return String;
      --  Returns the Nth tag attribute

      function Get_Tag_Attribute_Parameter_Count
        (Attribute_Number : Positive) return Natural;
      --  Returns the number of tag attribute parameters for the given
      --  attribute number.

      function Get_Tag_Attribute_Parameter
        (Attribute_Number, N : Positive) return String;
      --  Returns the Nth attribute's parameter for the given attribute number

      function Get_Tag_Attribute_Parameter_Internal
        (Attribute_Number, N : Positive; Count : out Natural) return String;
      --  Returns both the number of attribute parameter's and the Nth
      --  parameter.

      function Get_Tag_Parameter (N : Positive) return String;
      --  Returns the Nth tag parameter found between parenthesis

      function Get_Tag_Parameter_Count return Natural;
      --  Returns the number of parameter

      function Is_Stmt
        (Stmt : String; Extended : Boolean := False) return Boolean
        with Inline;
      --  Returns True if Stmt is found at the begining of the current line
      --  ignoring leading blank characters. If Extended is True it recognize
      --  statement attributes or parameter.

      function EOF return Boolean with Inline;
      --  Returns True if the end of file has been reach

      type Parse_Mode is
        (Parse_Std,              --  in standard line
         Parse_If,               --  in a if statement
         Parse_Elsif,            --  in elsif part of a if statement
         Parse_Else,             --  in else part of a if statement
         Parse_Extends,          --  in an extends statement
         Parse_Block,            --  in an extends' block statement
         Parse_Table,            --  in a table statement
         Parse_Table_Block,      --  in a table block statement
         Parse_Section,          --  in new section
         Parse_Section_Content,  --  in section content
         Parse_Inline,           --  in an inline block statement
         Parse_Macro             --  in a macro definition
        );

      function Parse
        (Mode    : Parse_Mode;
         In_If   : Boolean;
         No_Read : Boolean := False) return Tree;
      --  Get a line in File and returns the Tree

      ---------
      -- EOF --
      ---------

      function EOF return Boolean is
      begin
         return Last = 0;
      end EOF;

      -----------------
      -- Fatal_Error --
      -----------------

      procedure Fatal_Error (Message : String) is
      begin
         if Message (Message'Last) /= '.' then
            raise Template_Error
              with Message & ", in " & Filename
                & " at line" & Natural'Image (Line);
         else
            raise Template_Error
              with Message & ", included from " & Filename
                & " at line" & Natural'Image (Line);
         end if;
      end Fatal_Error;

      ------------------------
      -- Get_All_Parameters --
      ------------------------

      function Get_All_Parameters
        (At_Least_One : Boolean := True) return String
      is
         Start  : Natural;
         Offset : Natural := 0;
      begin
         --  Skip first word (tag statement, or include file name)

         if First < Last and then Buffer (First .. First + 1) = "@@" then
            Start := Strings.Fixed.Index (Buffer (First + 2 .. Last), "@@");
            Offset := 2;
         else
            Start := Strings.Fixed.Index (Buffer (First .. Last), Blank);
         end if;

         if Start = 0 or else Start + Offset >= Last then
            if At_Least_One then
               Fatal_Error ("missing parameter");
            else
               Start := Last + 1;
            end if;

         else
            Start := Start + Offset;
         end if;

         if Buffer (Last) = ASCII.CR then
            --  Last character is a DOS CR (certainly because the template
            --  file is in DOS format), ignore it as this is not part of the
            --  parameter.
            Last := Last - 1;
         end if;

         return Strings.Fixed.Trim
           (Buffer (Start .. Last), Left  => Blank, Right => Blank);
      end Get_All_Parameters;

      -------------------------
      -- Get_First_Parameter --
      -------------------------

      function Get_First_Parameter return Unbounded_String is
         Start, Stop : Natural;
         Offset      : Natural := 0;
      begin
         if First < Last and then Buffer (First .. First + 1) = "@@" then
            Start := Strings.Fixed.Index (Buffer (First + 2 .. Last), "@@");
            Offset := 2;
         else
            Start := Strings.Fixed.Index (Buffer (First .. Last), Blank);
         end if;

         if Start = 0 or else Start + Offset >= Last then
            return Null_Unbounded_String;
         else
            Start := Start + Offset;
         end if;

         Start := Strings.Fixed.Index (Buffer (Start .. Last), Blank, Outside);

         if Start = 0 then
            --  We have only spaces after the first word, there is no
            --  parameter in this case.
            return Null_Unbounded_String;
         end if;

         Stop := Strings.Fixed.Index (Buffer (Start .. Last), Blank);

         if Stop = 0 then
            Stop := Last;
         else
            Stop := Stop - 1;
         end if;

         return To_Unbounded_String (Buffer (Start .. Stop));
      end Get_First_Parameter;

      -------------------
      -- Get_Next_Line --
      -------------------

      function Get_Next_Line return Boolean is
         use type Maps.Character_Set;

         Skip_End : constant Maps.Character_Set :=
                      Blank or Maps.To_Set (ASCII.CR);
      begin
         if Input.End_Of_File (File) then
            Last := 0;
            return True;

         else
            loop
               Line := Line + 1;

               Input.Get_Line (File, Buffer, Last);

               First := Strings.Fixed.Index
                 (Buffer (1 .. Last), Blank, Outside);

               exit when First + 3 > Last
                 or else (First >= Buffer'First
                          and then Buffer (First .. First + 3) /= "@@--");

               if Input.End_Of_File (File) then
                  --  We have reached the end of file, exit now
                  Last := 0;
                  return True;
               end if;
            end loop;

            if First = 0 then
               --  There is only spaces on this line, this is an empty line
               --  we just have to skip it.
               Last := 0;
               return False;
            end if;

            --  Skip ending comments

            declare
               C : Natural;
            begin
               C := Strings.Fixed.Index (Buffer (First .. Last), "@@--");

               if C /= 0 then
                  Last := C - 1;
               end if;
            end;

            Last := Strings.Fixed.Index
              (Buffer (First .. Last), Skip_End, Outside, Strings.Backward);

            return False;
         end if;
      end Get_Next_Line;

      -----------------------
      -- Get_Tag_Attribute --
      -----------------------

      function Get_Tag_Attribute (N : Positive) return String is
         S      : Positive := First + 2;
         L      : constant Natural :=
                    Strings.Fixed.Index (Buffer (S .. Last), "@@");
         E      : Natural;
      begin
         for I in 1 .. N loop
            S := Strings.Fixed.Index (Buffer (S + 1 .. L), "'");
         end loop;

         --  Check for the end of this attribute

         declare
            E1 : constant Natural :=
                   Strings.Fixed.Index (Buffer (S + 1 .. L), "'");
            E2 : constant Natural :=
                   Strings.Fixed.Index (Buffer (S + 1 .. L), "(");
         begin
            if E1 > 0 and then (E1 < E2 or else E2 = 0) then
               E := E1;

            else
               E := E2;
            end if;
         end;

         if E = 0 then
            E := L;
         end if;

         return Buffer (S + 1 .. E - 1);
      end Get_Tag_Attribute;

      ---------------------------------
      -- Get_Tag_Attribute_Parameter --
      ---------------------------------

      function Get_Tag_Attribute_Parameter
        (Attribute_Number, N : Positive) return String
      is
         Count : Natural := 0;
      begin
         return Get_Tag_Attribute_Parameter_Internal
           (Attribute_Number, N, Count);
      end Get_Tag_Attribute_Parameter;

      ---------------------------------------
      -- Get_Tag_Attribute_Parameter_Count --
      ---------------------------------------

      function Get_Tag_Attribute_Parameter_Count
        (Attribute_Number : Positive) return Natural
      is
         Count : Natural := 0;
         A     : constant String :=
                   Get_Tag_Attribute_Parameter_Internal
                     (Attribute_Number, 1, Count) with Unreferenced;
      begin
         return Count;
      end Get_Tag_Attribute_Parameter_Count;

      ------------------------------------------
      -- Get_Tag_Attribute_Parameter_Internal --
      ------------------------------------------

      function Get_Tag_Attribute_Parameter_Internal
        (Attribute_Number, N : Positive; Count : out Natural) return String
      is
         Attribute : constant String := Get_Tag_Attribute (Attribute_Number);
         Start     : constant Positive :=
                       Strings.Fixed.Index (Buffer (First .. Last), Attribute)
                       + Attribute'Length + 1;
         In_Param  : Boolean := False;
         S, E      : Positive; -- parameter is between S and E
      begin
         Count := 0;

         Check_Parameters : for K in Start .. Last loop
            if Buffer (K) = '"' then
               if In_Param then
                  In_Param := False;

                  --  End of param being looked for

                  if Count = N then
                     E := K - 1;
                  end if;

               else
                  In_Param := True;
                  Count := Count + 1;

                  --  New parameter is the one looked for, record start

                  if Count = N then
                     S := K + 1;
                  end if;
               end if;

            elsif not In_Param and then Buffer (K) = ')' then
               exit Check_Parameters;

            elsif not In_Param and then Buffer (K) not in ' ' | ',' then
               Fatal_Error ("expecting coma between parameters");
            end if;
         end loop Check_Parameters;

         return Buffer (S .. E);
      end Get_Tag_Attribute_Parameter_Internal;

      -------------------------------
      -- Get_Tag_Attributes_Count --
      -------------------------------

      function Get_Tag_Attributes_Count return Natural is
         K : constant Natural :=
               Strings.Fixed.Index (Buffer (First + 2 .. Last), "@@");
      begin
         return Strings.Fixed.Count (Buffer (First + 2 .. K), "'");
      end Get_Tag_Attributes_Count;

      -----------------------
      -- Get_Tag_Parameter --
      -----------------------

      function Get_Tag_Parameter (N : Positive) return String is

         I_Last : constant Natural :=
                    Strings.Fixed.Index (Buffer (First .. Last), ")@@");

         function Find_Matching
           (From : Natural; Char : Character) return Natural;
         --  Returns the position of Char in Buffer, handle escaped characters

         -------------------
         -- Find_Matching --
         -------------------

         function Find_Matching
           (From : Natural; Char : Character) return Natural
         is
            K      : Natural := From;
            Level  : Integer;
            Escape : Integer := 0;
         begin
            if Char = ')' and then Buffer (K) = '(' then
               Level := 0;
            elsif Char = '(' then
               Level := -1;
            else
               Level := 1;
            end if;

            Look_For_Char : while K < I_Last loop
               if Buffer (K) = '\' and then Escape = 0 then
                  Escape := 2;
               end if;

               if Escape = 0 then
                  if Buffer (K) = '(' then
                     Level := Level + 1;
                  elsif Buffer (K) = ')' then
                     Level := Level - 1;
                  end if;
                  exit Look_For_Char when Buffer (K) = Char and then Level = 0;

               else
                  Escape := Escape - 1;
               end if;

               K := K + 1;
            end loop Look_For_Char;

            return K;
         end Find_Matching;

         F, L : Natural;

      begin
         if I_Last = 0 then
            Fatal_Error ("No tag parameter");

         else
            F := First;
            L := First - 1;

            for K in 1 .. N loop
               F := Find_Matching (L + 1, '(');

               if F = 0 then
                  Fatal_Error ("Missing parenthesis in tag command");

               else
                  --  Look for matching closing parenthesis
                  L := Find_Matching (F, ')');

                  if Buffer (L) /= ')' then
                     Fatal_Error
                       ("Missing closing parenthesis in tag command");
                  end if;
               end if;
            end loop;

            return Buffer (F + 1 .. L - 1);
         end if;
      end Get_Tag_Parameter;

      -----------------------------
      -- Get_Tag_Parameter_Count --
      -----------------------------

      function Get_Tag_Parameter_Count return Natural is
         I_Last : constant Natural :=
                    Strings.Fixed.Index (Buffer (First .. Last), ")@@");
         Count  : Natural := 0;
         Level  : Natural := 0;
         Escape : Integer := 0;
      begin
         if I_Last = 0 then
            return 0;

         else
            for K in First .. I_Last loop
               if Buffer (K) = '\' and then Escape = 0 then
                  Escape := 2;
               end if;

               if Escape = 0 then
                  if Buffer (K) = '(' then
                     if Level = 0 then
                        Count := Count + 1;
                     end if;
                     Level := Level + 1;
                  elsif Buffer (K) = ')' then
                     Level := Level - 1;
                  end if;

               else
                  Escape := Escape - 1;
               end if;
            end loop;

            return Count;
         end if;
      end Get_Tag_Parameter_Count;

      -------------
      -- Is_Stmt --
      -------------

      function Is_Stmt
        (Stmt : String; Extended : Boolean := False) return Boolean
      is
         Offset : Natural := 0;
      begin
         if Extended then
            Offset := 2;
         end if;

         return Last >= First + Stmt'Length - 1
           and then Buffer (First .. First + Stmt'Length - 1 - Offset) =
                      Stmt (Stmt'First .. Stmt'Last - Offset)
           and then (not Extended
                     or else
                       (Buffer (First + Stmt'Length - Offset) = '''
                        or else Buffer (First + Stmt'Length - Offset) = '('
                        or else Buffer (First + Stmt'Length - Offset) = '@'));
      end Is_Stmt;

      -----------
      -- Parse --
      -----------

      function Parse
        (Mode    : Parse_Mode;
         In_If   : Boolean;
         No_Read : Boolean := False) return Tree
      is
         use type Data.NKind;
         use type Data.Tree;

         function Count_Sections (T : Tree) return Natural with Inline;
         --  Returns the number of sections in T (Section_Stmt)

         function Count_Blocks (T : Tree) return Natural with Inline;
         --  Returns the number of sections in T (Table_Stmt)

         procedure Rewrite_Inlined_Block (T : Tree);
         --  Simplify the inline block by triming spaces. This is only the
         --  first step, the simplification will save some CPU cycle for each
         --  template rendering and makes the final inlining a bit more simple.

         procedure Parse_Included_File
           (Included : in out Included_File_Info;
            Error    : out Boolean);
         --  Parse the include file and parameters for a @@INCLUDE@@ or
         --  @@EXTENDS@@ statement

         ------------------
         -- Count_Blocks --
         ------------------

         function Count_Blocks (T : Tree) return Natural is
            C : Natural := 0;
            S : Tree    := T;
         begin
            while S /= null loop
               C := C + 1;
               S := S.Next;
            end loop;
            return C;
         end Count_Blocks;

         --------------------
         -- Count_Sections --
         --------------------

         function Count_Sections (T : Tree) return Natural is
            C : Natural := 0;
            S : Tree    := T;
         begin
            while S /= null loop
               C := C + 1;
               S := S.N_Section;
            end loop;
            return C;
         end Count_Sections;

         -------------------------
         -- Parse_Included_File --
         -------------------------

         procedure Parse_Included_File
           (Included : in out Included_File_Info;
            Error    : out Boolean)
         is
            File : constant String := To_String (Get_First_Parameter);
         begin
            Error := False;
            Included.Filename := Data.Parse (File, Line);

            if Included.Filename.Kind = Data.Text
              and then Included.Filename.Next = null
            then
               --  In the case of static strings we load the include file
               --  now.
               declare
                  I_Filename : constant String :=
                                 Build_Include_Pathname (Filename, File);
               begin
                  Included.File := Load (I_Filename, Cached, True);
               exception
                  when IO_Exceptions.Name_Error =>
                     --  File not found, this is an error only if we are not
                     --  inside a conditional.
                     if not In_If then
                        Error_Include_Message :=
                          To_Unbounded_String
                            ("Include file " & I_Filename & " not found.");
                        Error := True;
                        return;
                     end if;

                  when E : others =>
                     --  Error while parsing the include file, record this
                     --  error. Let the parser exit properly from the
                     --  recursion to be able to release properly the memory
                     --  before raising an exception.

                     Error_Include_Message :=
                       To_Unbounded_String (Exception_Message (E));
                     Error := True;
                     return;
               end;

               --  We do not need to keep reference to the include file in
               --  this case. The filename is static and already loaded.
               Data.Release (Included.Filename);
            end if;

            --  Move past @@INCLUDE@@

            First := First + 11;

            while First < Last and then Buffer (First) = ' ' loop
               First := First + 1;
            end loop;

            declare
               P_Set : constant Parameter_Set :=
                         (0 => To_Unbounded_String (File))
                         & Get_Parameters
                           (Get_All_Parameters (At_Least_One => False));
            begin
               Included.Params := Data.To_Data_Parameters (P_Set);
            end;
         end Parse_Included_File;

         ---------------------------
         -- Rewrite_Inlined_Block --
         ---------------------------

         procedure Rewrite_Inlined_Block (T : Tree) is

            procedure Rewrite (T : Tree);
            --  Last is set to True if we are checking the last node

            -------------
            -- Rewrite --
            -------------

            procedure Rewrite (T : Tree) is
               N : Tree := T;
               D : Data.Tree;
            begin
               while N /= null loop
                  case N.Kind is
                     when Text =>
                        D := N.Text;

                        --  Trim leading blanks

                        if D /= null and then D.Kind = Data.Text then
                           Trim (D.Value, Side => Left);
                        end if;

                     when If_Stmt =>
                        Rewrite (N.N_True);
                        Rewrite (N.N_False);

                     when Table_Stmt =>
                        Rewrite (N.Blocks);

                     when Section_Block =>
                        Rewrite (N.Common);
                        Rewrite (N.Sections);

                     when Section_Stmt =>
                        Rewrite (N.N_Section);

                     when others =>
                        null;
                  end case;

                  N := N.Next;
               end loop;
            end Rewrite;

         begin
            Rewrite (T);
         end Rewrite_Inlined_Block;

         T     : Tree;
         Error : Boolean;

      begin
         if not No_Read
           and then Mode /= Parse_Section
           and then Mode /= Parse_Elsif
           and then Mode /= Parse_Table_Block
         then
            if Get_Next_Line then
               return null;
            end if;
         end if;

         --  Check for Utf8 BOM, this can only occurs at the first line

         if Line = 1
           and then Last > Utils.BOM_Utf8'Length
           and then Buffer (1 .. Utils.BOM_Utf8'Length) = Utils.BOM_Utf8
         then
            T := new Node (Text);
            T.Line := Line;
            T.Text := Data.Parse (Buffer (1 .. Utils.BOM_Utf8'Length), Line);

            --  Removes BOM from buffer

            Buffer (1 .. Last - Utils.BOM_Utf8'Length) :=
              Buffer (1 + Utils.BOM_Utf8'Length .. Last);
            Last := Last - Utils.BOM_Utf8'Length;

            --  Continued parsing the remaining of the line

            T.Next := Parse (Mode, In_If, No_Read => True);
            return T;
         end if;

         case Mode is
            when Parse_Std =>
               if Is_Stmt (End_If_Token) then
                  Fatal_Error
                    ("@@END_IF@@ found outside an @@IF@@ statement");
               end if;

               if Is_Stmt (End_Table_Token) then
                  Fatal_Error
                    ("@@END_TABLE@@ found outside a @@TABLE@@ statement");
               end if;

               if Is_Stmt (End_Inline_Token) then
                  Fatal_Error
                    ("@@END_INLINE@@ found outside an @@INLINE@@ statement");
               end if;

               if Is_Stmt (End_Token) then
                  Fatal_Error
                    ("@@END@@ found outside a @@BEGIN@@ block statement");
               end if;

               if Is_Stmt (End_Macro_Token) then
                  Fatal_Error
                    ("@@END_MACRO@@ found outside a @@MACRO@@ statement");
               end if;

            when Parse_Extends =>
               if Is_Stmt (End_Extends_Token) then
                  return null;
               end if;

            when Parse_Block =>
               if Is_Stmt (End_Block_Token) then
                  return null;
               end if;

            when Parse_If =>
               if Is_Stmt (Else_Token)
                 or else Is_Stmt (Elsif_Token)
                 or else Is_Stmt (End_If_Token)
               then
                  return null;
               end if;

               if Is_Stmt (End_Table_Token) then
                  Fatal_Error ("@@END_TABLE@@ found, @@END_IF@@ expected");
               end if;

            when Parse_Elsif =>
               if Is_Stmt (Else_Token)
                 or else Is_Stmt (End_If_Token)
               then
                  return null;
               end if;

               if Is_Stmt (End_Table_Token) then
                  Fatal_Error ("@@END_TABLE@@ found, @@END_IF@@ expected");
               end if;

            when Parse_Else  =>
               if Is_Stmt (End_If_Token) then
                  return null;
               end if;

               if Is_Stmt (End_Table_Token) then
                  Fatal_Error ("@@END_TABLE@@ found, @@END_IF@@ expected");
               end if;

               if Is_Stmt (Elsif_Token) then
                  Fatal_Error ("@@ELSIF@@ found after @@ELSE@@");
               end if;

            when Parse_Table_Block =>
               if Is_Stmt (End_Table_Token) then
                  return null;
               end if;

               T := new Node (Section_Block);

               T.Line := Line;

               declare
                  Tmp : Tree;
               begin
                  Tmp := Parse (Parse_Section, In_If);

                  if Tmp = null then
                     --  This section is empty
                     return null;
                  end if;

                  if Is_Stmt (Begin_Token) then
                     --  It means that the section parsed above was common
                     T.Common   := Tmp.Next;

                     --  Now free the Section_Stmt container

                     Unchecked_Free (Tmp);

                     T.Sections := Parse (Parse_Section, In_If);

                  else
                     T.Common   := null;
                     T.Sections := Tmp;
                  end if;
               end;

               --  Count the number of section

               T.Sections_Count := Count_Sections (T.Sections);

               if T.Sections_Count = 1 and then T.Common = null then
                  --  A single section and no common section, rewrite it as a
                  --  simple common section.
                  T.Common := T.Sections.Next;
                  Unchecked_Free (T.Sections);
                  T.Sections_Count := 0;
               end if;

               if Is_Stmt (End_Table_Token) then
                  T.Next := null;
               else
                  T.Next := Parse (Parse_Table_Block, In_If);
               end if;

               return T;

            when Parse_Section =>
               if Is_Stmt (End_If_Token) then
                  Fatal_Error ("@@END_IF@@ found, @@END_TABLE@@ expected");
               end if;

               T := new Node (Section_Stmt);

               T.Line := Line;

               T.Next := Parse (Parse_Section_Content, In_If);

               if Is_Stmt (End_Table_Token) and then T.Next = null then
                  --  Check if this section was empty, this happen when
                  --  we parse a section after @@END@@ followed by the end
                  --  of the table.
                  Unchecked_Free (T);
                  return null;
               end if;

               if Is_Stmt (End_Table_Token)
                 or else Is_Stmt (Begin_Token)
                 or else Is_Stmt (End_Token)
               then
                  T.N_Section := null;

               elsif EOF then
                  Fatal_Error ("EOF found, @@END_TABLE@@ expected");

               else
                  T.N_Section := Parse (Parse_Section, In_If);
               end if;

               return T;

            when Parse_Section_Content =>
               if Is_Stmt (Section_Token)
                 or else Is_Stmt (End_Table_Token)
                 or else Is_Stmt (Begin_Token)
                 or else Is_Stmt (End_Token)
               then
                  return null;
               end if;

               if Is_Stmt (End_If_Token) then
                  Fatal_Error ("@@END_IF@@ found, @@END_TABLE@@ expected");
               end if;

            when Parse_Table =>
               if Is_Stmt (End_Table_Token) then
                  return null;
               end if;

               if Is_Stmt (End_If_Token) then
                  Fatal_Error ("@@END_IF@@ found, @@END_TABLE@@ expected");
               end if;

            when Parse_Inline =>
               if Is_Stmt (End_Inline_Token) then
                  return null;
               end if;

            when Parse_Macro =>
               if Is_Stmt (End_Macro_Token) then
                  return null;
               end if;

               if Is_Stmt (End_If_Token) then
                  Fatal_Error ("@@END_IF@@ found, @@END_MACRO@@ expected");
               end if;
         end case;

         if Is_Stmt (If_Token) or else Is_Stmt (Elsif_Token) then
            T := new Node (If_Stmt);

            T.Line := Line;

            T.Cond   := Expr.Parse (Get_All_Parameters, Line);
            T.N_True := Parse (Parse_If, In_If => True);

            if Is_Stmt (End_If_Token) then
               T.N_False := null;

            elsif Is_Stmt (Elsif_Token) then
               T.N_False := Parse (Parse_Elsif, In_If => True);

            elsif EOF then
               Fatal_Error ("EOF found, @@END_IF@@ expected");

            else
               T.N_False := Parse (Parse_Else, In_If => True);
            end if;

            T.Next := Parse (Mode, In_If);

            return T;

         elsif Is_Stmt (Extends_Token) then
            T := new Node (Extends_Stmt);

            T.Line := Line;

            Parse_Included_File (T.E_Included, Error);

            if Error then
               Unchecked_Free (T);
               return null;
            end if;

            I_File := new Node'
              (Kind       => Extends_Stmt,
               Next       => I_File,
               Line       => Line,
               N_Extends  => null,
               E_Included => T.E_Included);

            T.N_Extends := Parse (Parse_Extends, In_If => In_If);
            T.Next := Parse (Mode, In_If);
            return T;

         elsif Is_Stmt (Block_Token, Extended => True) then
            T := new Node (Block_Stmt);

            T.Line := Line;
            T.B_Name := To_Unbounded_String (Get_Tag_Parameter (1));
            T.N_Block := Parse (Parse_Block, In_If => In_If);
            T.Next := Parse (Mode, In_If);
            return T;

         elsif Is_Stmt (Table_Token, Extended => True) then
            T := new Node (Table_Stmt);

            T.Line := Line;
            T.Terminate_Sections := False;
            T.Reverse_Index      := False;
            T.Terse              := False;

            --  Check if first parameter is @@TERMINATE_SECTION@@, note that
            --  this is an obsolescent feature. It is better now to use the
            --  tag command attributes.

            declare
               Param : constant Unbounded_String := Get_First_Parameter;
            begin
               if Param = Null_Unbounded_String then
                  T.Terminate_Sections := False;
               elsif Param = Terminate_Sections_Token then
                  T.Terminate_Sections := True;
               else
                  Fatal_Error ("Unknown table parameter " & To_String (Param));
               end if;
            end;

            --  Check attributes

            for K in 1 .. Get_Tag_Attributes_Count loop
               declare
                  Att : constant String := Get_Tag_Attribute (K);
               begin
                  if Att = A_Terminate_Sections_Token then
                     T.Terminate_Sections := True;

                  elsif Att = A_Reverse_Token then
                     T.Reverse_Index := True;

                  elsif Att = A_Terse_Token then
                     T.Terse := True;

                  elsif Att = A_Aligh_On then
                     for P in 1 .. Get_Tag_Attribute_Parameter_Count (K) loop
                        T.Align_On.Append (Get_Tag_Attribute_Parameter (K, P));
                     end loop;

                  else
                     Fatal_Error ("Unknown table attributes " & Att);
                  end if;
               end;
            end loop;

            T.Blocks       := Parse (Parse_Table_Block, In_If);
            T.Next         := Parse (Mode, In_If);
            T.Blocks_Count := Count_Blocks (T.Blocks);

            --  Check now that if we have TERMINATE_SECTIONS option set and
            --  that there is more than one block, all blocks have the same
            --  number of section.

            if T.Terminate_Sections and then T.Blocks_Count >= 1 then
               declare
                  Size : constant Natural := T.Blocks.Sections_Count;
                  Max  : Natural := Size;
                  B    : Tree    := T.Blocks.Next;
               begin
                  while B /= null loop
                     Max := Natural'Max (Max, B.Sections_Count);

                     if B.Sections_Count /= Size
                       and then B.Sections_Count /= 0
                     then
                        Fatal_Error
                          ("All sections must have the same size "
                           & "when using TERMINATE_SECTIONS option");
                     end if;
                     B := B.Next;
                  end loop;

                  --  Check wether we have sections with the TERMINATE_SECTION
                  --  attribute.

                  if Max = 0 then
                     Fatal_Error
                       ("TERMINATE_SECTIONS attribute given, but no section"
                        & " defined");
                  end if;
               end;
            end if;

            return T;

         elsif Is_Stmt (Include_Token) then
            T := new Node (Include_Stmt);

            T.Line := Line;

            Parse_Included_File (T.I_Included, Error);

            if Error then
               Unchecked_Free (T);
               return null;
            end if;

            I_File := new Node'
              (Kind       => Include_Stmt,
               Next       => I_File,
               Line       => Line,
               I_Included => T.I_Included);
            T.Next := Parse (Mode, In_If);
            return T;

         elsif Is_Stmt (Macro_Token, Extended => True) then
            --  Parse a macro definition and register it

            declare
               Name : constant String := Get_Tag_Parameter (1);
               T    : constant Tree := Parse (Parse_Macro, In_If);

               procedure Move_To_Last (T : in out Tree);
               --  Move to last node

               procedure Rewrite (T : Tree);
               --  Rewrite this node, this is used to remove all CR/LF for
               --  the last lines which could be output for this tree.

               ------------------
               -- Move_To_Last --
               ------------------

               procedure Move_To_Last (T : in out Tree) is
               begin
                  while T.Next /= null loop
                     T := T.Next;
                  end loop;
               end Move_To_Last;

               -------------
               -- Rewrite --
               -------------

               procedure Rewrite (T : Tree) is
                  L : Tree := T;
                  D : Data.Tree;
               begin
                  if L /= null then
                     Move_To_Last (L);

                     case L.Kind is
                        when Text =>
                           --  A text node

                           D := L.Text;

                           --  Move to the end of this line

                           while D.Next /= null loop
                              D := D.Next;
                           end loop;

                           if D.Kind = Data.Text then
                              Strings.Unbounded.Trim
                                (D.Value,
                                 Left  => Maps.Null_Set,
                                 Right => Maps.To_Set (ASCII.CR & ASCII.LF));
                           end if;

                        when If_Stmt =>
                           Rewrite (L.N_True);
                           Rewrite (L.N_False);

                        when others =>
                           null;
                     end case;
                  end if;
               end Rewrite;

            begin
               --  We want to trim CR/LF from the last text node

               Rewrite (T);

               Macro.Register (Name, T);
            end;

            --  Then continue parsing the remaining of the file

            return Parse (Mode, In_If);

         elsif Is_Stmt (Set_Token) then
            --  We want to handle multiple SET lines to avoid deep recursion

            declare
               Root, N : Tree;
            begin
               loop
                  N := new Node (Set_Stmt);

                  if Root = null then
                     Root := N;
                  else
                     T.Next := N;
                  end if;

                  T      := N;
                  T.Line := Line;
                  T.Def  := Definitions.Parse (Get_All_Parameters);

                  if Get_Next_Line then
                     --  Nothing more, returns the result now
                     return Root;
                  end if;

                  --  If this is not a SET statement, just call the parsing
                  --  routine and return the root note.

                  if not Is_Stmt (Set_Token) then
                     T.Next := Parse (Mode, In_If, No_Read => True);
                     return Root;
                  end if;
               end loop;
            end;

         elsif Is_Stmt (Inline_Token, Extended => True) then
            T := new Node (Inline_Stmt);

            T.Line := Line;

            declare
               function Inline_Parameter
                 (Index : Positive) return Unbounded_String;
               --  Returns Inline_Parameter with the given index

               ----------------------
               -- Inline_Parameter --
               ----------------------

               function Inline_Parameter
                 (Index : Positive) return Unbounded_String
               is
                  P : constant String := Get_Tag_Parameter (Index);
                  N : Natural := P'First;
                  R : String (P'Range);
                  K : Natural := R'First - 1;
               begin
                  while N <= P'Last loop
                     if P (N) = '\' and then N < P'Last then
                        case P (N + 1) is
                           when '\' =>
                              K := K + 1;
                              R (K) := '\';
                              N := N + 1;

                           when 'n' =>
                              if Utils.Is_Windows then
                                 K := K + 2;
                                 R (K - 1 .. K) := (ASCII.CR, ASCII.LF);
                              else
                                 K := K + 1;
                                 R (K) := ASCII.LF;
                              end if;
                              N := N + 1;

                           when 'r' =>
                              K := K + 1;
                              R (K) := ASCII.LF;
                              N := N + 1;

                           when others =>
                              K := K + 1;
                              R (K) := P (N + 1);
                              N := N + 1;
                        end case;

                     else
                        K := K + 1;
                        R (K) := P (N);
                     end if;

                     N := N + 1;
                  end loop;

                  return To_Unbounded_String (R (R'First .. K));
               end Inline_Parameter;

            begin
               case Get_Tag_Parameter_Count is
                  when 0 =>
                     T.Sep    := To_Unbounded_String (" ");
                  when 1 =>
                     T.Sep    := Inline_Parameter (1);
                  when 3 =>
                     T.Before := Inline_Parameter (1);
                     T.Sep    := Inline_Parameter (2);
                     T.After  := Inline_Parameter (3);
                  when others =>
                     Fatal_Error
                       ("Wrong number of tag parameters for INLINE "
                        & "command (0, 1 or 3)");
               end case;
            end;

            T.I_Block := Parse (Parse_Inline, In_If);

            Rewrite_Inlined_Block (T.I_Block);

            T.Next := Parse (Mode, In_If);

            return T;

         else
            declare
               Root, N : Tree;
            begin
               loop
                  N := new Node (Text);

                  if Root = null then
                     Root := N;
                  else
                     T.Next := N;
                  end if;

                  T      := N;
                  T.Line := Line;

                  if Input.LF_Terminated (File)
                        and then
                     (not Input.End_Of_File (File) or else Include_File)
                  then
                     --  Add a LF if the read line is terminated by a LF. Do
                     --  not add this LF if we reach the end of file except for
                     --  included files.

                     T.Text :=
                       Data.Parse (Buffer (1 .. Last) & ASCII.LF, Line);
                  else
                     T.Text := Data.Parse (Buffer (1 .. Last), Line);
                  end if;

                  if Get_Next_Line then
                     --  Nothing more, returns the result now
                     return Root;
                  end if;

                  --  If this is a statement just call the parsing routine

                  if Is_Stmt (If_Token)
                    or else Is_Stmt (Elsif_Token)
                    or else Is_Stmt (Else_Token)
                    or else Is_Stmt (End_If_Token)
                    or else Is_Stmt (Include_Token)
                    or else Is_Stmt (Table_Token, Extended => True)
                    or else Is_Stmt (Section_Token)
                    or else Is_Stmt (End_Table_Token)
                    or else Is_Stmt (End_Extends_Token)
                    or else Is_Stmt (End_Block_Token)
                    or else Is_Stmt (Extends_Token)
                    or else Is_Stmt (Block_Token, Extended => True)
                    or else Is_Stmt (Begin_Token)
                    or else Is_Stmt (End_Token)
                    or else Is_Stmt (Set_Token)
                    or else Is_Stmt (Inline_Token, Extended => True)
                    or else Is_Stmt (End_Inline_Token)
                    or else Is_Stmt (Macro_Token, Extended => True)
                    or else Is_Stmt (End_Macro_Token)
                  then
                     T.Next := Parse (Mode, In_If, No_Read => True);
                     return Root;
                  end if;
               end loop;
            end;
         end if;
      end Parse;

      T     : Static_Tree;
      New_T : Tree;
      Old   : Tree;

   begin
      Templates_Parser_Tasking.Lock;

      if Cached then
         Cached_Files.Get (Filename, Result => T);

         if T /= Null_Static_Tree then
            pragma Assert (T.C_Info /= null);
            Templates_Parser_Tasking.Unlock;
            return T;
         end if;
      end if;

      Input.Open (File, Filename, Form => "shared=no");

      begin
         New_T := Parse (Parse_Std, False);

         Simplifier.Run (New_T);

         Input.Close (File);
      exception
         when others =>
            Input.Close (File);
            raise;
      end;

      --  T is the tree file, add two nodes (Info and C_Info) in front of
      --  the tree.

      --  Add second node (cache info)

      Old := new Node'(Kind     => C_Info,
                       Next     => New_T,
                       Line     => 0,
                       Obsolete => False,
                       Used     => 1);

      --  Add first node (info about tree)

      New_T := new Node'(Kind      => Info,
                         Next      => Old,
                         Line      => 0,
                         Filename  => To_Unbounded_String (Filename),
                         Timestamp => Configuration.File_Time_Stamp (Filename),
                         I_File    => I_File);

      if Error_Include_Message /= Null_Unbounded_String then
         --  An include filename was not found, release the memory now and
         --  raise a fatal error.

         Release (New_T);

         Fatal_Error (To_String (Error_Include_Message));
      end if;

      if Cached then
         Cached_Files.Add (Filename, New_T, Old);
         pragma Assert (Old /= null);
      end if;

      Templates_Parser_Tasking.Unlock;
      return Static_Tree'(New_T, Old);

   exception
      when E : Internal_Error =>
         Templates_Parser_Tasking.Unlock;
         Fatal_Error (Exceptions.Exception_Message (E));
      when others =>
         Templates_Parser_Tasking.Unlock;
         raise;
   end Load;

   --------------
   -- No_Quote --
   --------------

   function No_Quote (Str : String) return String is
   begin
      if Str'Length > 1
        and then Str (Str'First) = '"'
        and then Str (Str'Last) = '"'
      then
         return Str (Str'First + 1 .. Str'Last - 1);
      else
         return Str;
      end if;
   end No_Quote;

   -----------
   -- Parse --
   -----------

   function Parse
     (Filename          : String;
      Translations      : Translate_Table       := No_Translation;
      Cached            : Boolean               := False;
      Keep_Unknown_Tags : Boolean               := False;
      Lazy_Tag          : Dyn.Lazy_Tag_Access   := Dyn.Null_Lazy_Tag;
      Cursor_Tag        : Dyn.Cursor_Tag_Access := Dyn.Null_Cursor_Tag;
      Report            : access procedure (Tag_Name : String;
                                            Filename : String := "";
                                            Line     : Natural := 0;
                                            Reason   : Reason_Kind) := null)
      return String is
   begin
      return To_String
        (Parse (Filename, Translations, Cached,
                Keep_Unknown_Tags, Lazy_Tag, Cursor_Tag, Report));
   end Parse;

   function Parse
     (Filename          : String;
      Translations      : Translate_Table       := No_Translation;
      Cached            : Boolean               := False;
      Keep_Unknown_Tags : Boolean               := False;
      Lazy_Tag          : Dyn.Lazy_Tag_Access   := Dyn.Null_Lazy_Tag;
      Cursor_Tag        : Dyn.Cursor_Tag_Access := Dyn.Null_Cursor_Tag;
      Report            : access procedure (Tag_Name : String;
                                            Filename : String := "";
                                            Line     : Natural := 0;
                                            Reason   : Reason_Kind) := null)
      return Unbounded_String is
   begin
      return Parse
        (Filename, To_Set (Translations), Cached,
         Keep_Unknown_Tags, Lazy_Tag, Cursor_Tag, Report);
   end Parse;

   function Parse
     (Filename          : String;
      Translations      : Translate_Set;
      Cached            : Boolean               := False;
      Keep_Unknown_Tags : Boolean               := False;
      Lazy_Tag          : Dyn.Lazy_Tag_Access   := Dyn.Null_Lazy_Tag;
      Cursor_Tag        : Dyn.Cursor_Tag_Access := Dyn.Null_Cursor_Tag;
      Report            : access procedure (Tag_Name : String;
                                            Filename : String := "";
                                            Line     : Natural := 0;
                                            Reason   : Reason_Kind) := null)
      return String is
   begin
      return To_String
        (Parse (Filename, Translations, Cached,
                Keep_Unknown_Tags, Lazy_Tag, Cursor_Tag, Report));
   end Parse;

   function Parse
     (Filename          : String;
      Translations      : Translate_Set;
      Cached            : Boolean               := False;
      Keep_Unknown_Tags : Boolean               := False;
      Lazy_Tag          : Dyn.Lazy_Tag_Access   := Dyn.Null_Lazy_Tag;
      Cursor_Tag        : Dyn.Cursor_Tag_Access := Dyn.Null_Cursor_Tag;
      Report            : access procedure (Tag_Name : String;
                                            Filename : String := "";
                                            Line     : Natural := 0;
                                            Reason   : Reason_Kind) := null)
      return Unbounded_String
   is
      package Name_Set is new Containers.Indefinite_Ordered_Sets (String);

      Max_Nested_Levels : constant := 10;
      --  The maximum number of table nested levels

      type Block_State is record
         Section_Number : Positive;
         Section        : Tree;
      end record;

      Empty_Block_State : constant Block_State := (1, null);

      type Parse_State;
      type Parse_State_Access is access constant Parse_State;

      type Parse_State (P_Size : Natural) is record
         Cursor        : Indices (1 .. Max_Nested_Levels);
         Max_Lines     : Natural;
         Max_Expand    : Natural;
         Reverse_Index : Boolean;
         Table_Level   : Natural;
         Inline_Sep    : Unbounded_String;
         Filename      : Unbounded_String;
         Line          : Natural;
         Blocks_Count  : Natural;
         I_Params      : Data.Parameters;
         F_Params      : Parameter_Set (1 .. P_Size);
         Block         : Block_State;
         Terse_Table   : Boolean;
         Parent        : Parse_State_Access;
      end record;

      Empty_State : constant Parse_State :=
                      (0, (1 .. Max_Nested_Levels => 0), 0, 0, False, 0,
                       Null_Unbounded_String, Null_Unbounded_String, 0, 0,
                       null, No_Parameter, Empty_Block_State, False, null);

      Results : Unbounded_String := Null_Unbounded_String;

      Buffer  : String (1 .. 4 * 1_024);
      Last    : Natural := 0;
      --  Cache to avoid too many reallocation using Append on Results above

      Now      : Calendar.Time;
      D_Map    : Definitions.Map;
      Lazy_Set : Translate_Set;
      Output   : Boolean;

      Named_Blocks  : Tree_Map.Map;
      --  The blocks for @@EXTENDS@@

      In_Extends    : Natural := 0;
      --  nesting level of @@EXTENDS@@ block we are analyzing. 0 outside
      --  such a block.

      Unused_Variables : Name_Set.Set;

      procedure Flush with Inline;
      --  Flush buffer to Results

      procedure Analyze
        (T     : Tree;
         State : Parse_State);
      --  Parse T and build results file. State is needed for Vector_Tag and
      --  Matrix_Tag expansion.

      -------------
      -- Analyze --
      -------------

      procedure Analyze
        (T     : Tree;
         State : Parse_State)
      is
         use type Data.Tree;

         function NS
           (State : Parse_State; Line : Natural) return Parse_State
           with Inline;
         --  Returns a new Parse_State with just the line updated

         function Analyze (E : Expr.Tree) return String;
         --  Analyse the expression tree and returns the result as a boolean
         --  The conditional expression must be equal to either TRUE or
         --  FALSE. Note that a string is True if it is equal to string "TRUE"
         --  and False otherwise.

         procedure Analyze (D : Data.Tree);
         --  Analyse the data tree and replace all variables by the
         --  correspinding value specified in Translations. This procedure
         --  catenate the result into Results variable.

         procedure Analyze (Included : in out Included_File_Info);
         --  Analyze the imported file

         procedure Get_Max
           (T          : Tree;
            Max_Lines  :    out Natural;
            Max_Expand :    out Natural);
         --  Returns the maximum number of lines (Max_Lines) into the
         --  table. This correspond to the length of the shortest vector tag
         --  into the table or the shortest number of lines in sub-table
         --  matrix tag.
         --  Returns also the number of time the table will be expanded
         --  (Max_Expand), this is equal to Max_Lines + offset to terminate
         --  the sections.

         function Translate
           (Var          : Data.Tag_Var;
            State        : Parse_State;
            Is_Composite : access Boolean) return String;
         --  Translate Tag variable using Translation table and apply all
         --  Filters and Atribute recorded for this variable.

         function I_Translate
           (Var   : Data.Tag_Var;
            State : Parse_State) return String;
         --  As above but for an include variable

         procedure Add (S : String);
         --  Add S into Results (using Buffer cache if possible). If Sep is
         --  true S is a separator. We keep track of this as we do not want to
         --  have two separators side by side.

         function Get_Mark return Natural with Inline;
         --  Get a mark on the current text buffer

         function Get_Marked_Text (Mark : Natural) return String;
         --  Returns the text from the mark to the end of the buffer

         function Get_Association
           (Var  : Data.Tag_Var;
            Line : Natural) return Association;
         --  Returns association for Name or Null_Association if not found.
         --  This routine also handles lazy tags by calling the appropriate
         --  callback routine. Lazy tag values are then recorded into Lazy_Set.

         procedure Rollback (Activate : Boolean; Mark : Natural) with Inline;
         --  Commit or rollback added texts for terse output. If no text added
         --  from the vector tag we rollback to the previous mark otherwise the
         --  current result stays. The mark is cleared.

         function Flatten_Parameters
           (I : Data.Parameter_Set) return Parameter_Set;
         --  Returns a flat representation of the include parameters, only the
         --  name or the value are kept. The tree are replaced by an empty
         --  value.

         function Flatten_Parameters
           (I : Data.Parameters) return Parameter_Set;
         --  As above but for an access to a Parameter_Set

         function Inline_Cursor_Tag
           (Cursor_Tag : Dynamic.Cursor_Tag_Access;
            Var_Name   : String;
            Dim        : Positive;
            Path       : Dynamic.Path) return Unbounded_String;
         --  Returns the Cursor_Tag Var_Name inlined for all dimensions
         --  starting from Path.

         function Align_On
           (Seps : String_Set.Vector;
            Text : String) return String;
         --  Align text given the State.Align_On separators

         function Rewrite_Inlined_Block
           (T : Tree; Block : String) return String;
         --  Do inline the block, add the Before and After strings and Sep
         --  after each line.

         L_State : aliased constant Parse_State := State;

         ---------
         -- Add --
         ---------

         procedure Add (S : String) is
         begin
            if Last + S'Length > Buffer'Last then
               --  Not enough cache space, flush buffer
               Flush;
            end if;

            if S'Length >= Buffer'Length then
               Append (Results, S);
            else
               Buffer (Last + 1 .. Last + S'Length) := S;
               Last := Last + S'Length;
            end if;
         end Add;

         --------------
         -- Align_On --
         --------------

         function Align_On
           (Seps  : String_Set.Vector;
            Text  : String) return String
         is
            Cols   : array (Positive range 1 .. Positive (Seps.Length))
                       of Natural := (others => 0);
            LS     : Positive := Text'First;  -- line start
            LE     : Natural  := 0;           -- line end
            Result : Unbounded_String;        -- Text aligned
         begin
            --  Look for columns in Text and set the separators column in Cols

            Check_Cols : while LS < Text'Last loop
               --  Check for line start .. end
               LE := Strings.Fixed.Index (Text, String'(1 => ASCII.LF), LS);

               if LE = 0 then
                  LE := Text'Last;
               end if;

               --  Check for separators

               Update_Cols : declare
                  I   : Positive := Cols'First;
                  P   : Positive := LS;
                  Loc : Natural;
                  NP  : Natural;
                  Ofs : Natural := 0;
               begin
                  for S of Seps loop
                     Loc := Strings.Fixed.Index (Text (LS .. LE), S, P);

                     if Loc > 0 then
                        P := Loc;

                        NP := P - LS + 1 + Ofs; -- new pos

                        --  We have a previous position recorded

                        if Cols (I) /= 0 then
                           if NP > Cols (I) then
                              --  The new position is above the current
                              --  one. This is going to be the new value
                              --  and so we need to shift all columns of
                              --  the corresponding offset.

                              for K in I + 1 .. Cols'Last loop
                                 Cols (K) := Cols (K) + (NP - Cols (I));
                              end loop;

                           elsif NP < Cols (I) then
                              --  Increase offset of the current line as we
                              --  need to add spaces before the separator for
                              --  it to be aligned with the current column.

                              Ofs := Ofs + (Cols (I) - NP);
                           end if;
                        end if;

                        --  And finally update this columns

                        Cols (I) := Natural'Max (Cols (I), NP);

                        P := P + S'Length;
                     end if;

                     I := I + 1;
                  end loop;
               end Update_Cols;

               LS := LE + 1;
            end loop Check_Cols;

            --  Add necessary spaces to align elements in columns

            LS := Text'First;

            Set_Cols : while LS < Text'Last loop
               --  Check for line start .. end
               LE := Strings.Fixed.Index (Text, String'(1 => ASCII.LF), LS);

               if LE = 0 then
                  LE := Text'Last;
               end if;

               --  Check for separators

               declare
                  use Strings.Fixed;
                  Line   : Unbounded_String :=
                             To_Unbounded_String (Text (LS .. LE));
                  I      : Positive := Cols'First;
                  P      : Positive := LS;
                  Loc    : Natural;
                  Spaces : Natural := 0;
                  Offset : Natural := 0;
               begin
                  for S of Seps loop
                     Loc := Index (Text (LS .. LE), S, P);

                     if Loc > 0
                       and then Cols (I) - Loc + LS - Offset > 0
                     then
                        P := Loc;

                        Spaces := Cols (I) - P + LS - Offset - 1;

                        if Spaces > 0 then
                           Insert
                             (Source   => Line,
                              Before   => Offset + P - LS + 1,
                              New_Item => String'(Spaces * ' '));
                           Offset := Offset + Spaces;
                        end if;

                        P := P + S'Length;
                     end if;

                     I := I + 1;
                  end loop;

                  Append (Result, Line);
               end;

               LS := LE + 1;
            end loop Set_Cols;

            return To_String (Result);
         end Align_On;

         -------------
         -- Analyze --
         -------------

         procedure Analyze (D : Data.Tree) is
            T : Data.Tree := D;
         begin
            while T /= null loop
               case T.Kind is
                  when Data.Text =>
                     Add (To_String (T.Value));

                  when Data.Var =>
                     if Data.Is_Include_Variable (T.Var) then
                        Add (I_Translate (T.Var, State));

                     else
                        declare
                           use Strings.Fixed;
                           use type Data.Attribute;

                           Is_Composite : aliased Boolean;
                           Value        : constant String :=
                                            Translate
                                              (T.Var, NS (State, T.Line),
                                               Is_Composite'Access);
                        begin
                           --  Only adds to the buffer if variable value is not
                           --  empty. This is needed as we want to track empty
                           --  values to be able to rollback if necessary on
                           --  the terse mode. Note that we handle only
                           --  composite tags which are part of the table
                           --  expansion.

                           if Value /= "" then
                              if T.Col = 1
                                   or else
                                  T.Var.Attribute.Attr /= Data.Indent
                                   or else
                                  Index (Value, String'(1 => ASCII.LF)) = 0
                              then
                                 Add (Value);

                              else
                                 --  We have some LF into the string and the
                                 --  tag is not placed at the start of the
                                 --  line, we need to indent the content.

                                 declare
                                    Spaces : constant Positive := T.Col - 1;
                                    V      : Unbounded_String :=
                                               To_Unbounded_String (Value);
                                    P      : Natural := 1;
                                 begin
                                    Indent_Content : loop
                                       P := Index
                                         (V, String'(1 => ASCII.LF), P);

                                       exit Indent_Content when P = 0;

                                       P := P + 1;

                                       Insert
                                         (V,
                                          Before   => P,
                                          New_Item => String'(Spaces * ' '));

                                       P := P + Spaces;
                                    end loop Indent_Content;

                                    Add (To_String (V));
                                 end;
                              end if;

                              Output := Is_Composite;
                           end if;
                        end;
                     end if;
               end case;

               T := T.Next;
            end loop;
         end Analyze;

         -------------
         -- Analyze --
         -------------

         function Analyze (E : Expr.Tree) return String is

            type Ops_Fct is access function (L, R : Expr.Tree) return String;

            function F_And  (L, R : Expr.Tree) return String;
            function F_Or   (L, R : Expr.Tree) return String;
            function F_Xor  (L, R : Expr.Tree) return String;
            function F_Sup  (L, R : Expr.Tree) return String;
            function F_Esup (L, R : Expr.Tree) return String;
            function F_Einf (L, R : Expr.Tree) return String;
            function F_Inf  (L, R : Expr.Tree) return String;
            function F_Equ  (L, R : Expr.Tree) return String;
            function F_Diff (L, R : Expr.Tree) return String;
            function F_In   (L, R : Expr.Tree) return String;
            function F_Cat  (L, R : Expr.Tree) return String;

            type U_Ops_Fct is access function (N : Expr.Tree) return String;

            function F_Not (N : Expr.Tree) return String;

            -----------
            -- F_And --
            -----------

            function F_And (L, R : Expr.Tree) return String is
            begin
               if Expr.Is_True (Analyze (L))
                 and then Expr.Is_True (Analyze (R))
               then
                  return "TRUE";
               else
                  return "FALSE";
               end if;
            end F_And;

            -----------
            -- F_Cat --
            -----------

            function F_Cat (L, R : Expr.Tree) return String is
            begin
               return Analyze (L) & Analyze (R);
            end F_Cat;

            ------------
            -- F_Diff --
            ------------

            function F_Diff (L, R : Expr.Tree) return String is
            begin
               if Analyze (L) /= Analyze (R) then
                  return "TRUE";
               else
                  return "FALSE";
               end if;
            end F_Diff;

            ------------
            -- F_Einf --
            ------------

            function F_Einf (L, R : Expr.Tree) return String is
               LV : constant String := Analyze (L);
               RV : constant String := Analyze (R);
            begin
               if Utils.Is_Number (LV) and then Is_Number (RV) then
                  if Integer'Value (LV) <= Integer'Value (RV) then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;

               else
                  if LV <= RV then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;
               end if;
            end F_Einf;

            -----------
            -- F_Equ --
            -----------

            function F_Equ (L, R : Expr.Tree) return String is
            begin
               if Analyze (L) = Analyze (R) then
                  return "TRUE";
               else
                  return "FALSE";
               end if;
            end F_Equ;

            ------------
            -- F_Esup --
            ------------

            function F_Esup (L, R : Expr.Tree) return String is
               LV : constant String := Analyze (L);
               RV : constant String := Analyze (R);
            begin
               if Utils.Is_Number (LV) and then Is_Number (RV) then
                  if Integer'Value (LV) >= Integer'Value (RV) then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;

               else
                  if LV >= RV then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;
               end if;
            end F_Esup;

            ----------
            -- F_In --
            ----------

            function F_In (L, R : Expr.Tree) return String is
               use type Expr.NKind;

               procedure Build_Set (Data : in out Tag_Data);
               --  Returns TRUE or FALSE depending if Value is found in the tag

               ---------------
               -- Build_Set --
               ---------------

               procedure Build_Set (Data : in out Tag_Data) is

                  procedure Process (N : Tag_Node_Access);
                  --  Insert all values pointed to by N

                  -------------
                  -- Process --
                  -------------

                  procedure Process (N : Tag_Node_Access) is
                     L : Tag_Node_Access := N;
                  begin
                     while L /= null loop
                        if L.Kind = Templates_Parser.Value then
                           Data.Values.Include (To_String (L.V));

                        elsif L.Kind = Value_Set then
                           Process (L.VS.Data.Head);
                        end if;
                        L := L.Next;
                     end loop;
                  end Process;

               begin
                  Process (Data.Head);
               end Build_Set;

            begin
               if R.Kind = Expr.Var then
                  declare
                     LL : constant String := Analyze (L);
                     Tk : constant Association :=
                            Get_Association (R.Var, R.Line);
                  begin
                     case Tk.Kind is
                        when Std =>
                           if LL = To_String (Tk.Value) then
                              return "TRUE";
                           else
                              return "FALSE";
                           end if;

                        when Composite =>
                           if Tk.Comp_Value.Data.Values = null then
                              --  Build map of values for fast test
                              Tk.Comp_Value.Data.Values := new Tag_Values.Set;
                              Build_Set (Tk.Comp_Value.Data.all);
                           end if;

                           if Tk.Comp_Value.Data.Values.Contains (LL) then
                              return "TRUE";
                           else
                              return "FALSE";
                           end if;
                     end case;
                  end;

               else
                  raise Template_Error
                    with "in operator right operand must be a tag";
               end if;
            end F_In;

            -----------
            -- F_Inf --
            -----------

            function F_Inf (L, R : Expr.Tree) return String is
               LV : constant String := Analyze (L);
               RV : constant String := Analyze (R);
            begin
               if Utils.Is_Number (LV) and then Is_Number (RV) then
                  if Integer'Value (LV) < Integer'Value (RV) then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;

               else
                  if LV < RV then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;
               end if;
            end F_Inf;

            -----------
            -- F_Not --
            -----------

            function F_Not (N : Expr.Tree) return String is
            begin
               if Expr.Is_True (Analyze (N)) then
                  return "FALSE";
               else
                  return "TRUE";
               end if;
            end F_Not;

            ----------
            -- F_Or --
            ----------

            function F_Or (L, R : Expr.Tree) return String is
            begin
               if Expr.Is_True (Analyze (L))
                 or else Expr.Is_True (Analyze (R))
               then
                  return "TRUE";
               else
                  return "FALSE";
               end if;
            end F_Or;

            -----------
            -- F_Sup --
            -----------

            function F_Sup (L, R : Expr.Tree) return String is
               LV : constant String := Analyze (L);
               RV : constant String := Analyze (R);
            begin
               if Utils.Is_Number (LV) and then Is_Number (RV) then
                  if Integer'Value (LV) > Integer'Value (RV) then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;

               else
                  if LV > RV then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;
               end if;
            end F_Sup;

            -----------
            -- F_Xor --
            -----------

            function F_Xor (L, R : Expr.Tree) return String is
            begin
               if Expr.Is_True (Analyze (L))
                 xor Expr.Is_True (Analyze (R))
               then
                  return "TRUE";
               else
                  return "FALSE";
               end if;
            end F_Xor;

            Op_Table     : constant array (Expr.Ops) of Ops_Fct :=
                             (Expr.O_And   => F_And'Access,
                              Expr.O_Or    => F_Or'Access,
                              Expr.O_Xor   => F_Xor'Access,
                              Expr.O_Sup   => F_Sup'Access,
                              Expr.O_Inf   => F_Inf'Access,
                              Expr.O_Esup  => F_Esup'Access,
                              Expr.O_Einf  => F_Einf'Access,
                              Expr.O_Equal => F_Equ'Access,
                              Expr.O_Diff  => F_Diff'Access,
                              Expr.O_In    => F_In'Access,
                              Expr.O_Cat   => F_Cat'Access);

            U_Op_Table   : constant array (Expr.U_Ops) of U_Ops_Fct :=
                             (Expr.O_Not => F_Not'Access);

            Is_Composite : aliased Boolean;

         begin
            case E.Kind is
               when Expr.Value =>
                  return To_String (E.V);

               when Expr.Var =>
                  if Data.Is_Include_Variable (E.Var) then
                     return I_Translate (E.Var, State);
                  else
                     return Translate
                       (E.Var, NS (State, E.Line), Is_Composite'Access);
                  end if;

               when Expr.Op =>
                  return Op_Table (E.O) (E.Left, E.Right);

               when Expr.U_Op =>
                  return U_Op_Table (E.U_O) (E.Next);
            end case;
         end Analyze;

         -------------
         -- Analyze --
         -------------

         procedure Analyze (Included : in out Included_File_Info) is
         begin
            if Included.Filename /= null then
               --  This is a deferred include file load as the name of the
               --  include file was not a static string.
               Flush;
               Analyze (Included.Filename);

               declare
                  Filename : constant String := Buffer (1 .. Last);
                  S_File   : Static_Tree;
               begin
                  Last := 0; --  Removes include filename from the buffer

                  S_File := Load (Build_Include_Pathname
                                  (To_String (State.Filename), Filename),
                                  Cached, True);

                  if S_File /= Included.File then
                     if Cached then
                        if Included.File.C_Info /= null then
                           Cached_Files.Release (Included.File);
                        end if;
                     else
                        Release (Included.File.Info);
                     end if;
                  end if;

                  Included.File := S_File;
               end;
            end if;

            Analyze (Included.File.Info,
                     Parse_State'(Included.Params'Length,
                       Cursor        => State.Cursor,
                       Max_Lines     => State.Max_Lines,
                       Max_Expand    => State.Max_Expand,
                       Reverse_Index => State.Reverse_Index,
                       Table_Level   => State.Table_Level,
                       Inline_Sep    => State.Inline_Sep,
                       Filename      => Included.File.Info.Filename,
                       Line          => State.Line,
                       Blocks_Count  => State.Blocks_Count,
                       I_Params      => Included.Params,
                       F_Params      => Flatten_Parameters
                         (Included.Params),
                       Block         => State.Block,
                       Terse_Table   => State.Terse_Table,
                       Parent        => L_State'Unchecked_Access));
         end Analyze;

         ------------------------
         -- Flatten_Parameter  --
         ------------------------

         function Flatten_Parameters
           (I : Data.Parameter_Set) return Parameter_Set
         is
            F            : Parameter_Set (I'Range);
            Is_Composite : aliased Boolean;
         begin
            for K in I'Range loop
               if I (K) = null then
                  F (K) := Null_Unbounded_String;
               else
                  case I (K).Kind is
                     when Data.Text =>
                        F (K) := I (K).Value;
                     when Data.Var  =>
                        F (K) := To_Unbounded_String
                          (Translate
                             (I (K).Var, NS (State, I (K).Line),
                              Is_Composite'Access));
                  end case;
               end if;
            end loop;
            return F;
         end Flatten_Parameters;

         function Flatten_Parameters
           (I : Data.Parameters) return Parameter_Set
         is
            use type Data.Parameters;
         begin
            if I = null then
               return No_Parameter;
            else
               return Flatten_Parameters (I.all);
            end if;
         end Flatten_Parameters;

         ---------------------
         -- Get_Association --
         ---------------------

         function Get_Association
           (Var  : Data.Tag_Var;
            Line : Natural) return Association
         is
            use type Data.Internal_Tag;
            use type Dynamic.Lazy_Tag_Access;
            Name :  constant String := To_String (Var.Name);
            Pos  : Association_Map.Cursor;
         begin
            Pos := Translations.Set.Find (Name);

            if Association_Map.Has_Element (Pos) then
               Unused_Variables.Exclude (Name);
               return Association_Map.Element (Pos);

            elsif Lazy_Tag /= Dynamic.Null_Lazy_Tag
              and then not Filter.Is_No_Dynamic (Var.Filters)
              and then Var.Internal = Data.No
            then
               --  Look into the Lazy_Set for the cached value

               Pos := Lazy_Set.Set.Find (Name);

               if Association_Map.Has_Element (Pos) then
                  return Association_Map.Element (Pos);

               else
                  --  Check for Lazy tag

                  Dynamic.Value (Lazy_Tag, Name, Lazy_Set);

                  return Get (Lazy_Set, Name);
               end if;

            else
               if Report /= null then
                  Report
                    (Name, To_String (State.Filename), Line, Undefined);
               end if;

               return Null_Association;
            end if;
         end Get_Association;

         --------------
         -- Get_Mark --
         --------------

         function Get_Mark return Natural is
         begin
            Output := False;
            return Length (Results) + Last;
         end Get_Mark;

         ---------------------
         -- Get_Marked_Text --
         ---------------------

         function Get_Marked_Text (Mark : Natural) return String is
            Len : constant Natural :=
                    Length (Results) + Last - Mark;
         begin
            if Len > 0 then
               if Last >= Len then
                  --  Enough data into the buffer
                  return Buffer (Last - Len + 1 .. Last);

               else
                  --  Get part from result
                  return Slice
                    (Results,
                     Low  => Length (Results) - Len + Last + 1,
                     High => Length (Results)) & Buffer (1 .. Last);
               end if;

            else
               return "";
            end if;
         end Get_Marked_Text;

         -------------
         -- Get_Max --
         -------------

         procedure Get_Max
           (T          : Tree;
            Max_Lines  :    out Natural;
            Max_Expand :    out Natural)
         is

            function Get_Max_Lines
              (T : Tree; N : Positive) return Natural;
            --  Recursivelly descends the tree and compute the max lines that
            --  will be displayed into the table. N is the variable embedded
            --  level regarding the table statement. N=1 means that the
            --  variable is just under the analysed table. N=2 means that the
            --  variable is found inside a nested table statement. And so on.

            -------------------
            -- Get_Max_Lines --
            -------------------

            function Get_Max_Lines
              (T : Tree; N : Positive) return Natural
            is

               function Check (T : Data.Tree) return Natural;
               --  Returns the length of the largest vector tag found on the
               --  subtree.

               function Check (T : Expr.Tree) return Natural;
               --  Idem for an expression subtree as found in a condition

               function Check (T : Data.Tag_Var) return Natural;
               --  Returns the length of Tag T for the current context

               function Check
                 (I : not null access Data.Parameter_Set) return Natural;
               --  Returns the length of the largest vector tag found on the
               --  include parameters.

               function Get_Max_Lines
                 (Included : Included_File_Info;
                  N        : Positive) return Natural;
               --  Return the max lines for Included

               -----------
               -- Check --
               -----------

               function Check (T : Data.Tag_Var) return Natural is

                  Table_Level : constant Positive := State.Table_Level + 1;
                  --  This is the current table level, State.Table_Level is
                  --  not yet updated when calling this routine hence the +1.

                  Var_Level   : constant Natural := State.Table_Level + N;
                  --  This is the variable nested table level. O means that the
                  --  variable is not inside a table statement.

                  function Max (T : Tag; N : Natural) return Natural;
                  --  Returns the maximum number of items for the Nth Tag level

                  function Max
                    (Name : String; N : Natural; Path : Dynamic.Path)
                     return Natural;
                  --  Idem for a Cursor_Tag

                  ---------
                  -- Max --
                  ---------

                  function Max (T : Tag; N : Natural) return Natural is
                     Result : Natural := 0;
                     P      : Tag_Node_Access := T.Data.Head;
                  begin
                     while P /= null loop
                        if P.Kind = Value_Set then
                           if N = 1 then
                              Result :=
                                Natural'Max (Result, P.VS.Data.Count);
                           else
                              Result := Natural'Max
                                (Result, Max (P.VS.all, N - 1));
                           end if;
                        end if;
                        P := P.Next;
                     end loop;
                     return Result;
                  end Max;

                  function Max
                    (Name : String; N : Natural; Path : Dynamic.Path)
                     return Natural
                  is
                     use type Dynamic.Path;
                     Result : Natural := 0;
                     L : Natural;
                  begin
                     L := Dynamic.Length (Cursor_Tag, Name, Path);

                     for K in 1 .. L loop
                        if Path'Length = N then
                           Result := Natural'Max
                             (Result,
                              Dynamic.Length (Cursor_Tag, Name, Path & K));
                        else
                           Result := Natural'Max
                             (Result, Max (Name, N, Path & K));
                        end if;
                     end loop;

                     return Result;
                  end Max;

               begin
                  declare
                     use type Dynamic.Cursor_Tag_Access;
                     Tk : constant Association :=
                            Get_Association (T, State.Line);
                  begin
                     if Tk = Null_Association then
                        if Cursor_Tag /= Dynamic.Null_Cursor_Tag then
                           --  Check the Cursor_Tag
                           declare
                              Name : constant String := To_String (T.Name);
                              D, K : Natural;
                              L1   : Natural;
                           begin
                              D := Dynamic.Dimension (Cursor_Tag, Name);

                              if N > D then
                                 --  Ignore this variable as it is deeper than
                                 --  its dimension.
                                 return 0;

                              elsif D /= 0 then
                                 --  This is a Cursor_Tag

                                 K := D - N + 1;
                                 --  K is the variable indice for which
                                 --  the number of items is looked for.

                                 if D > Table_Level then
                                    --  The variable dimensions is bigger than
                                    --  the current table level. This means
                                    --  that the index needs to be updated so
                                    --  that the outer table tag statement will
                                    --  be the first var index.
                                    K := K - (D - Var_Level);
                                 end if;

                                 L1 := Dynamic.Length
                                   (Cursor_Tag, Name, Path => (1 => 1));

                                 if D = 1 and then L1 = 1 then
                                    --  Not a composite tag
                                    return 0;

                                 elsif K = 1 then
                                    return L1;

                                 else
                                    return Max (Name, K - 1, (1 => 1));
                                 end if;
                              end if;
                           end;
                        end if;

                     else
                        if Tk.Kind = Composite then
                           if N > Tk.Comp_Value.Data.Nested_Level then
                              --  Ignore this variable as it is deeper than
                              --  its nested level.
                              return 0;
                           end if;

                           --  We look first at two common cases to handle
                           --  more efficiently tag into a single or two
                           --  table statements.

                           if Table_Level = 1
                             or else Tk.Comp_Value.Data.Nested_Level = 1
                           then
                              --  First table level, or flat composite, the
                              --  number of iterations corresponds to the
                              --  number of item into this tag.
                              return Size (Tk.Comp_Value);

                           elsif Table_Level = 2
                             and then N = 1
                           then
                              --  Table level 2 while looking to nested
                              --  variable.
                              return Tk.Comp_Value.Data.Max;

                           else
                              --  All other cases here
                              declare
                                 K : constant Positive
                                   := Tk.Comp_Value.Data.Nested_Level - N + 1;
                                 --  K is the variable indice for which
                                 --  the number of items is looked for.
                              begin
                                 if K = 1 then
                                    return Size (Tk.Comp_Value);
                                 elsif K = 2 then
                                    return Tk.Comp_Value.Data.Max;
                                 else
                                    return Max (Tk.Comp_Value, K - 1);
                                 end if;
                              end;
                           end if;
                        end if;
                     end if;
                  end;

                  return 0;
               end Check;

               function Check (T : Data.Tree) return Natural is
                  use type Data.Attribute;
                  use type Data.NKind;

                  Iteration : Natural := Natural'First;
                  D         : Data.Tree := T;
               begin
                  while D /= null loop
                     if D.Kind = Data.Var
                       and then D.Var.Attribute.Attr = Data.Nil
                     then
                        Iteration := Natural'Max (Iteration, Check (D.Var));
                     end if;

                     D := D.Next;
                  end loop;

                  return Iteration;
               end Check;

               function Check (T : Expr.Tree) return Natural is
               begin
                  case T.Kind is
                     when Expr.Var   =>
                        return Natural'Max (0, Check (T.Var));
                     when Expr.Op    =>
                        return Natural'Max (Check (T.Left), Check (T.Right));
                     when Expr.U_Op  =>
                        return Natural'Max (0, Check (T.Next));
                     when Expr.Value =>
                        return 0;
                  end case;
               end Check;

               function Check
                 (I : not null access Data.Parameter_Set) return Natural
               is
                  Iteration : Natural := Natural'First;
               begin
                  for K in I'Range loop
                     if I (K) /= null then
                        Iteration := Natural'Max (Iteration, Check (I (K)));
                     end if;
                  end loop;
                  return Iteration;
               end Check;

               function Get_Max_Lines
                 (Included : Included_File_Info;
                  N        : Positive) return Natural is
               begin
                  return Natural'Max
                    (Get_Max_Lines (Included.File.Info, N),
                     Check (Included.Params));
               end Get_Max_Lines;

            begin
               if T = null then
                  return Natural'First;
               end if;

               case T.Kind is
                  when Info | C_Info | Set_Stmt =>
                     return Get_Max_Lines (T.Next, N);

                  when Text =>
                     return Natural'Max
                       (Check (T.Text), Get_Max_Lines (T.Next, N));

                  when If_Stmt =>
                     return Natural'Max
                       (Check (T.Cond),
                        Natural'Max
                          (Get_Max_Lines (T.Next, N),
                           Natural'Max
                             (Get_Max_Lines (T.N_True, N),
                              Get_Max_Lines (T.N_False, N))));

                  when Table_Stmt =>
                     return Natural'Max
                       (Get_Max_Lines (T.Blocks, N + 1),
                        Get_Max_Lines (T.Next, N));

                  when Section_Block =>
                     return Natural'Max
                       (Get_Max_Lines (T.Next, N),
                        Natural'Max
                          (Get_Max_Lines (T.Common, N),
                           Get_Max_Lines (T.Sections, N)));

                  when Extends_Stmt =>
                     return Natural'Max
                       (Get_Max_Lines (T.E_Included, N),
                        Natural'Max
                          (Get_Max_Lines (T.N_Extends, N),
                           Get_Max_Lines (T.Next, N)));

                  when Block_Stmt =>
                     return Natural'Max
                       (Get_Max_Lines (T.Next, N),
                        Get_Max_Lines (T.N_Block, N));

                  when Section_Stmt =>
                     return Natural'Max
                       (Get_Max_Lines (T.Next, N),
                        Get_Max_Lines (T.N_Section, N));

                  when Include_Stmt =>
                     return Natural'Max
                       (Get_Max_Lines (T.I_Included, N),
                        Get_Max_Lines (T.Next, N));

                  when Inline_Stmt =>
                     return Natural'Max
                       (Get_Max_Lines (T.Next, N),
                        Get_Max_Lines (T.I_Block, N));
               end case;
            end Get_Max_Lines;

            Result : Natural := Get_Max_Lines (T.Blocks, 1);

         begin
            pragma Assert (T.Kind = Table_Stmt);

            Max_Lines := Result;

            if T.Terminate_Sections then
               --  ??? This part of code handle properly only table with a
               --  single block. What should be done if there is multiple
               --  blocks ? Should all blocks be of the same size ?

               declare
                  N_Section : constant Natural := T.Blocks.Sections_Count;
               begin
                  if Result mod N_Section /= 0 then
                     Result := Result + N_Section - (Result mod N_Section);
                  end if;
               end;
            end if;

            Max_Expand := Result;
         end Get_Max;

         -----------------
         -- I_Translate --
         -----------------

         function I_Translate
           (Var   : Data.Tag_Var;
            State : Parse_State) return String
         is
            use type Data.Attribute;
            use type Data.NKind;
            use type Data.Parameters;
         begin
            pragma Assert (Var.N /= -1);

            if State.I_Params /= null
              and then Var.N <= State.I_Params'Last
              and then State.I_Params (Var.N) /= null
            then
               declare
                  T : constant Data.Tree := State.I_Params (Var.N);
                  --  T is the data tree that should be evaluated in place
                  --  of the include variable.
                  C : aliased Filter.Filter_Context :=
                        (State.F_Params'Length,
                         Translations, Lazy_Tag, State.F_Params);
                  Is_Composite : aliased Boolean;
               begin
                  if T.Next = null and then T.Kind = Data.Var then
                     --  Here we have a special case where the include
                     --  variable is replaced by a single variable.

                     declare
                        V : Data.Tag_Var := T.Var;
                     begin
                        if V.N = -1 then
                           --  First thing we want to do is to inherit
                           --  attributes from the include variable if we
                           --  have no attribute.

                           if V.Attribute.Attr = Data.Nil then
                              V.Attribute := Var.Attribute;
                           end if;

                           --  Note that below we pass the parent state. This
                           --  is required as if the variable is an alias to
                           --  to an include parameter we need to get the
                           --  value for this variable in parent state. If the
                           --  variable is a standard one (from a translate
                           --  table) the state will not be used.

                           return Data.Translate
                             (Var,
                              Translate
                                (V, State.Parent.all, Is_Composite'Access),
                                 C'Access);

                        else
                           --  This variable reference a parent include
                           --  variable.

                           return I_Translate (V, State.Parent.all);
                        end if;
                     end;

                  else
                     --  Here we flush the buffer and then we analyse the
                     --  include parameter. The result is contained into
                     --  the buffer which is large enough for an include
                     --  variable.

                     Flush;
                     Analyze (T);

                     declare
                        L : constant Natural := Last;
                     begin
                        Last := 0;
                        return Data.Translate
                          (Var, Buffer (Buffer'First .. L), C'Access);
                     end;
                  end if;
               end;

            else
               return "";
            end if;
         end I_Translate;

         -----------------------
         -- Inline_Cursor_Tag --
         -----------------------

         function Inline_Cursor_Tag
           (Cursor_Tag : Dynamic.Cursor_Tag_Access;
            Var_Name   : String;
            Dim        : Positive;
            Path       : Dynamic.Path) return Unbounded_String
         is
            use type Dynamic.Path;
            Result : Unbounded_String;
            L      : Natural;
         begin
            L := Dynamic.Length (Cursor_Tag, Var_Name, 1 & Path);

            for K in 1 .. L loop
               if Result /= Null_Unbounded_String then
                  Append (Result, ' ');
               end if;

               if Dim = Path'Length + 1 then
                  Append
                    (Result,
                     Dynamic.Value (Cursor_Tag, Var_Name, Path & K));
               else
                  Append
                    (Result,
                     Inline_Cursor_Tag
                       (Cursor_Tag, Var_Name, Dim, Path & K));
               end if;
            end loop;

            return Result;
         end Inline_Cursor_Tag;

         --------
         -- NS --
         --------

         function NS
           (State : Parse_State; Line : Natural) return Parse_State is
         begin
            return (Parse_State'(State.P_Size,
                    State.Cursor,
                    State.Max_Lines,
                    State.Max_Expand,
                    State.Reverse_Index,
                    State.Table_Level,
                    State.Inline_Sep,
                    State.Filename,
                    Line,
                    State.Blocks_Count,
                    State.I_Params,
                    State.F_Params,
                    State.Block,
                    State.Terse_Table,
                    State.Parent));
         end NS;

         ---------------------------
         -- Rewrite_Inlined_Block --
         ---------------------------

         function Rewrite_Inlined_Block
           (T : Tree; Block : String) return String
         is
            Sep    : constant String := To_String (T.Sep);
            Start  : Positive := Block'First;
            Pos    : Natural;
            Offset : Natural;
            Next   : Natural;
            Result : Unbounded_String := T.Before;
         begin
            Next := Strings.Fixed.Index
              (Block (Start .. Block'Last), String'(1 => ASCII.LF));

            --  No end-of-line separator, let's handle the whole line

            if Next = 0 then
               Next := Block'Last;
            end if;

            --  Add all lines (separator is LF) add Sep after each one

            loop
               Pos := Next;
               exit when Pos = 0;

               if Pos = Block'First or else Block (Pos) /= ASCII.LF then
                  --  A single character or line without LF
                  Offset := 0;
               elsif Pos > Block'First and then Block (Pos - 1) = ASCII.CR then
                  --  We have a CR + LF
                  Offset := 2;
               else
                  --  Just a single LF, standard separator
                  Offset := 1;
               end if;

               --  Add line content

               Append (Result, Block (Start .. Pos - Offset));

               Start := Pos + 1;

               Next := Strings.Fixed.Index
                 (Block (Start .. Block'Last), String'(1 => ASCII.LF));

               --  Add Sep or handle the last line

               if Next = 0 then
                  --  Last line in the INLINE, add the After string and the
                  --  final CR/LF.

                  Append (Result, T.After);
                  Append (Result, Block (Pos - Offset + 1 .. Pos));

               else
                  Append (Result, Sep);
               end if;
            end loop;

            return To_String (Result);
         end Rewrite_Inlined_Block;

         --------------
         -- Rollback --
         --------------

         procedure Rollback (Activate : Boolean; Mark : Natural) is
         begin
            if Activate then
               --  Rollback

               Rollback : declare
                  To_Delete : constant Natural :=
                                Length (Results) + Last - Mark;
               begin
                  if To_Delete > 0 then
                     if Last >= To_Delete then
                        --  Enough data into the buffer, remove from it
                        Last := Last - To_Delete;

                     else
                        --  Remove remaining data from results
                        Delete
                          (Results,
                           From    => Length (Results) - To_Delete + Last + 1,
                           Through => Length (Results));

                        --  Clear buffer

                        Last := 0;
                     end if;
                  end if;
               end Rollback;
            end if;
         end Rollback;

         ---------------
         -- Translate --
         ---------------

         function Translate
           (Var          : Data.Tag_Var;
            State        : Parse_State;
            Is_Composite : access Boolean) return String
         is
            use type Data.Parameters;
            use type Filter.Set_Access;

            C        : aliased Filter.Filter_Context :=
                         (State.F_Params'Length,
                          Translations, Lazy_Tag, State.F_Params);
            D_Pos    : Definitions.Def_Map.Cursor;
            Up_Value : Natural := 0;
         begin
            Is_Composite.all := False;

            if Var.Is_Macro then
               --  Two possibilities, either we have a macro inlined here or a
               --  user macro.

               if Var.Def = null then
                  --  A user defined macro, use callback if any
                  if Macro.Callback /= null then
                     declare
                        Name   : constant String := To_String (Var.Name);
                        Params : Parameter_Set (Var.Parameters'Range);
                     begin
                        --  Set parameters
                        for K in Params'Range loop
                           Flush;
                           Analyze (Var.Parameters (K));

                           Params (K) := To_Unbounded_String
                             (Buffer (Buffer'First .. Last));
                           Last := 0;
                        end loop;

                        return Data.Translate
                          (Var, Macro.Callback (Name, Params), C'Access);
                     end;
                  end if;

               else
                  declare
                     Mark : constant Natural := Get_Mark;
                  begin
                     Analyze (Var.Def, State);

                     --  Apply filters if any to the result

                     if Var.Filters /= null then
                        declare
                           V : constant String := Get_Marked_Text (Mark);
                        begin
                           Rollback (True, Mark);
                           return Data.Translate (Var, V, C'Access);
                        end;

                     else
                        return "";
                     end if;
                  end;
               end if;
            end if;

            D_Pos := Definitions.Def_Map.Find
              (D_Map, To_String (Var.Name));

            if Definitions.Def_Map.Has_Element (D_Pos) then
               --  We have a definition for this variable in the template
               declare
                  N : constant Definitions.Node :=
                        Definitions.Def_Map.Element (D_Pos);
                  V : Data.Tag_Var := Var;
               begin
                  case N.Kind is
                     when Definitions.Const =>
                        return Data.Translate
                          (Var, To_String (N.Value), C'Access);

                     when Definitions.Ref =>
                        V.N := N.Ref;
                        return I_Translate (V, State);

                     when Definitions.Ref_Default =>
                        if State.I_Params = null
                          or else N.Ref > State.I_Params'Last
                          or else State.I_Params (N.Ref) = null
                        then
                           --  This include parameter does not exist, use
                           --  default value.
                           return Data.Translate
                             (Var, To_String (N.Value), C'Access);
                        else
                           V.N := N.Ref;
                           return I_Translate (V, State);
                        end if;
                  end case;
               end;
            end if;

            declare
               use type Data.Attribute;
               use type Dynamic.Cursor_Tag_Access;
               use type Dynamic.Path;
               Tk : constant Association := Get_Association (Var, State.Line);
            begin
               if Tk = Null_Association then

                  if Cursor_Tag /= Dynamic.Null_Cursor_Tag then
                     --  Check the Cursor_Tag
                     declare
                        Name         : constant String := To_String (Var.Name);
                        D, L         : Natural;
                        Valid_Cursor : Boolean := True;
                     begin
                        D := Dynamic.Dimension (Cursor_Tag, Name);

                        if D /= 0 then
                           if Var.Attribute.Attr /= Data.Nil then
                              --  ??? Would be nice to remove this restriction
                              raise Template_Error with
                                "Attributes not supported for Cursor_Tag.";
                           end if;

                           --  This is a Cursor_Tag, check that the current
                           --  table cursor is valid for it.

                           for K in 1 .. D loop
                              if State.Cursor (K) >
                                Dynamic.Length
                                  (Cursor_Tag, Name,
                                   1 & State.Cursor (1 .. K - 1))
                              then
                                 Valid_Cursor := False;
                              end if;
                           end loop;

                           if Valid_Cursor then

                              L := Dynamic.Length
                                (Cursor_Tag, Name,
                                 1 & State.Cursor
                                   (1 .. State.Table_Level - 1));

                              if D = 1 and then L = 1 then
                                 --  A standard tag (single value)
                                 return Data.Translate
                                   (Var,
                                    Dynamic.Value (Cursor_Tag, Name, (1 => 1)),
                                    C'Access);

                              else
                                 --  A composite tag, check that the dimension
                                 --  of the tag correspond to the current table
                                 --  nested level.

                                 if D = State.Table_Level then
                                    return Data.Translate
                                      (Var,
                                       Dynamic.Value
                                         (Cursor_Tag, Name,
                                          State.Cursor (1 .. D)), C'Access);

                                 else
                                    --  Otherwise we inline the structure
                                    return To_String
                                      (Inline_Cursor_Tag
                                         (Cursor_Tag, Name, D,
                                          State.Cursor
                                            (1 .. State.Table_Level)));
                                 end if;
                              end if;
                           end if;
                        end if;
                     end;
                  end if;

               else
                  case Tk.Kind is
                     when Std =>
                        if Var.Attribute.Attr in Data.Nil | Data.Indent then
                           return Data.Translate
                             (Var, To_String (Tk.Value), C'Access);
                        else
                           raise Template_Error
                             with "Attribute not valid on a discrete tag ("
                               & Data.Image (Var) & ')';
                        end if;

                     when Composite =>
                        Is_Composite.all := True;
                        if Tk.Comp_Value.Data.Nested_Level = 1 then
                           --  This is a vector

                           if Var.Attribute.Attr = Data.Length then
                              return Data.Translate
                                (Var,
                                 Utils.Image
                                   (Tk.Comp_Value.Data.Count), C'Access);

                           elsif Var.Attribute.Attr = Data.Up_Level then
                              Up_Value := Var.Attribute.Value;

                           elsif Var.Attribute.Attr /= Data.Nil then
                              raise Template_Error
                                with "This attribute is not valid for a "
                                  & "vector tag (" & Data.Image (Var) & ')';
                           end if;

                        elsif Tk.Comp_Value.Data.Nested_Level = 2 then
                           if Var.Attribute.Attr = Data.Line then
                              --  'Line on a matrix
                              return Data.Translate
                                (Var,
                                 Utils.Image (Tk.Comp_Value.Data.Count),
                                 C'Access);

                           elsif Var.Attribute.Attr = Data.Min_Column then
                              --  'Min_Column on a matrix
                              return Data.Translate
                                (Var,
                                 Utils.Image (Tk.Comp_Value.Data.Min),
                                 C'Access);

                           elsif Var.Attribute.Attr = Data.Max_Column then
                              --  'Max_Column on a matrix
                              return Data.Translate
                                (Var,
                                 Utils.Image (Tk.Comp_Value.Data.Max),
                                 C'Access);

                           elsif Var.Attribute.Attr /= Data.Nil then
                              raise Template_Error
                                with "This attribute is not valid for a "
                                  & "matrix tag (" & Data.Image (Var) & ')';
                           end if;
                        end if;

                        declare
                           Result : Unbounded_String;
                           Found  : Boolean;
                        begin
                           Field
                             (Tk.Comp_Value,
                              State.Cursor (1 .. State.Table_Level),
                              Up_Value,
                              Result, Found);

                           return Data.Translate
                             (Var, To_String (Result), C'Access);
                        end;
                  end case;
               end if;
            end;

            case Var.Internal is
               when Data.Up_Table_Line =>
                  if State.Table_Level < 2 then
                     return Data.Translate (Var, "0", C'Access);
                  else
                     return Data.Translate
                       (Var,
                        Utils.Image (State.Cursor (State.Table_Level - 1)),
                        C'Access);
                  end if;

               when Data.Table_Line =>
                  if State.Table_Level = 0 then
                     return Data.Translate (Var, "0", C'Access);
                  else
                     return Data.Translate
                       (Var,
                        Utils.Image (State.Cursor (State.Table_Level)),
                        C'Access);
                  end if;

               when Data.Number_Line =>
                  return Data.Translate
                    (Var, Utils.Image (State.Max_Lines), C'Access);

               when Data.Table_Level =>
                  return Data.Translate
                    (Var, Utils.Image (State.Table_Level), C'Access);

               when Data.Now =>
                  return Data.Translate
                    (Var,
                     GNAT.Calendar.Time_IO.Image (Now, "%Y-%m-%d %H:%M:%S"),
                     C'Access);

               when Data.Year =>
                  return Data.Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%Y"), C'Access);

               when Data.Month =>
                  return Data.Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%m"), C'Access);

               when Data.Day =>
                  return Data.Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%d"), C'Access);

               when Data.Hour =>
                  return Data.Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%H"), C'Access);

               when Data.Minute =>
                  return Data.Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%M"), C'Access);

               when Data.Second =>
                  return Data.Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%S"), C'Access);

               when Data.Month_Name =>
                  return Data.Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%B"), C'Access);

               when Data.Day_Name =>
                  return Data.Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%A"), C'Access);

               when Data.No =>
                  null;
            end case;

            --  The tag was not found in the Translation_Table, we either
            --  returns the empty string or we keep the tag as is.

            if Keep_Unknown_Tags then
               return Data.Image (Var);
            else
               return Data.Translate (Var, "", C'Access);
            end if;
         end Translate;

      begin
         if T = null then
            return;
         end if;

         case T.Kind is
            when Info | C_Info =>
               Analyze (T.Next, State);

            when Text =>
               declare
                  N : Tree := T;
               begin
                  begin
                     --  Handles all consecutive Text nodes

                     while N /= null and then N.Kind = Text loop
                        Analyze (N.Text);
                        N := N.Next;
                     end loop;

                  exception
                     when E : others =>
                        raise Template_Error
                          with Exceptions.Exception_Message (E)
                            & " In " & Filename
                            & " at line" & Natural'Image (N.Line);
                  end;

                  Analyze (N, State);
               end;

            when Set_Stmt =>
               declare
                  N : Tree := T;
               begin
                  begin
                     --  Handles all consecutive Set nodes

                     while N /= null and then N.Kind = Set_Stmt loop
                        Handle_Set : declare
                           Name    : constant String := To_String (N.Def.Name);
                           Pos     : Definitions.Def_Map.Cursor;
                           Success : Boolean;
                        begin
                           Pos := D_Map.Find (Name);

                           if Definitions.Def_Map.Has_Element (Pos) then
                              D_Map.Replace_Element (Pos, New_Item => N.Def.N);
                           else
                              D_Map.Insert (Name, N.Def.N, Pos, Success);
                           end if;
                        end Handle_Set;

                        N := N.Next;
                     end loop;
                  end;

                  Analyze (N, State);
               end;

            when If_Stmt  =>
               begin
                  if Expr.Is_True (Analyze (T.Cond)) then
                     Analyze (T.N_True, State);
                  else
                     Analyze (T.N_False, State);
                  end if;
               exception
                  when E : others =>
                     raise Template_Error
                       with Exceptions.Exception_Message (E)
                         & " In " & Filename
                         & " at line" & Natural'Image (T.Line);
               end;

               Analyze (T.Next, State);

            when Table_Stmt =>
               declare
                  Start_Pos             : Positive;
                  End_Pos               : Natural;
                  Max_Lines, Max_Expand : Natural;
               begin
                  Get_Max (T, Max_Lines, Max_Expand);

                  if not T.Align_On.Is_Empty then
                     Flush;
                     Start_Pos := Length (Results) + 1;
                  end if;

                  Analyze (T.Blocks,
                           Parse_State'(State.F_Params'Length,
                                        State.Cursor,
                                        Max_Lines, Max_Expand,
                                        T.Reverse_Index,
                                        State.Table_Level + 1,
                                        State.Inline_Sep,
                                        State.Filename,
                                        T.Line,
                                        T.Blocks_Count,
                                        State.I_Params,
                                        State.F_Params,
                                        Empty_Block_State,
                                        T.Terse,
                                        L_State'Unchecked_Access));

                  --  Align_On attribute present

                  if not T.Align_On.Is_Empty then
                     Flush;
                     End_Pos := Length (Results);

                     --  we have some content for the table. Let's align it as
                     --  needed.

                     if Start_Pos < End_Pos then
                        Replace_Slice
                          (Results, Start_Pos, End_Pos,
                           Align_On
                             (T.Align_On,
                              Slice (Results, Start_Pos, End_Pos)));
                     end if;
                  end if;
               end;

               Analyze (T.Next, State);

            when Extends_Stmt =>
               --  Expand all the blocks, and create temporary variables from
               --  them.

               In_Extends := In_Extends + 1;
               Analyze (T.N_Extends, State);
               In_Extends := In_Extends - 1;

               Analyze (T.E_Included);

               --  ??? Should now remove the temporary variables

               Analyze (T.Next, State);

            when Block_Stmt =>
               if In_Extends = 0 then
                  declare
                     B : constant Tree_Map.Cursor :=
                           Named_Blocks.Find (To_String (T.B_Name));
                  begin
                     if Tree_Map.Has_Element (B) then
                        Analyze (Tree_Map.Element (B), State);
                     else
                        --  Use default value
                        Analyze (T.N_Block, State);
                     end if;
                  end;

               else
                  --  add the block's expansion to the variables
                  Named_Blocks.Include (To_String (T.B_Name), T.N_Block);
               end if;

               Analyze (T.Next, State);

            when Section_Block =>
               declare
                  B_State : array (1 .. State.Blocks_Count) of Block_State :=
                              (others => Empty_Block_State);
                  B       : Positive;
                  Mark    : Natural := 0;
               begin
                  for K in 1 .. State.Max_Expand loop
                     if State.Terse_Table then
                        Mark := Get_Mark;
                     end if;

                     declare
                        New_Cursor : Indices := State.Cursor;
                        Block      : Tree    := T;
                     begin
                        if State.Reverse_Index then
                           New_Cursor (State.Table_Level) :=
                             State.Max_Expand - K + 1;
                        else
                           New_Cursor (State.Table_Level) := K;
                        end if;

                        B := 1;

                        while Block /= null loop
                           --  For all blocks in this table

                           if B_State (B).Section = null
                             or else B_State (B).Section.N_Section = null
                           then
                              B_State (B) := (1, Block.Sections);
                           else
                              B_State (B) :=
                                (B_State (B).Section_Number + 1,
                                 B_State (B).Section.N_Section);
                           end if;

                           Analyze
                             (Block.Common,
                              Parse_State'(State.F_Params'Length,
                                           New_Cursor,
                                           State.Max_Lines, State.Max_Expand,
                                           State.Reverse_Index,
                                           State.Table_Level,
                                           State.Inline_Sep,
                                           State.Filename,
                                           Block.Line,
                                           State.Blocks_Count,
                                           State.I_Params,
                                           State.F_Params,
                                           Empty_Block_State,
                                           State.Terse_Table,
                                           L_State'Unchecked_Access));

                           Analyze
                             (Block.Sections,
                              Parse_State'(State.F_Params'Length,
                                           New_Cursor,
                                           State.Max_Lines, State.Max_Expand,
                                           State.Reverse_Index,
                                           State.Table_Level,
                                           State.Inline_Sep,
                                           State.Filename,
                                           Block.Line,
                                           State.Blocks_Count,
                                           State.I_Params,
                                           State.F_Params,
                                           B_State (B),
                                           State.Terse_Table,
                                           L_State'Unchecked_Access));

                           Block := Block.Next;
                           B := B + 1;
                        end loop;

                        if State.Terse_Table then
                           Rollback (Activate => Output = False, Mark => Mark);
                        end if;
                     end;
                  end loop;
               end;

            when Section_Stmt =>
               Analyze
                 (State.Block.Section.Next,
                  Parse_State'(State.F_Params'Length,
                               State.Cursor,
                               State.Max_Lines, State.Max_Expand,
                               State.Reverse_Index,
                               State.Table_Level,
                               State.Inline_Sep,
                               State.Filename,
                               T.Line,
                               State.Blocks_Count,
                               State.I_Params,
                               State.F_Params,
                               State.Block,
                               State.Terse_Table,
                               L_State'Unchecked_Access));

            when Include_Stmt =>
               Analyze (T.I_Included);
               Analyze (T.Next, State);

            when Inline_Stmt =>
               declare
                  Start_Pos  : Positive;
                  End_Pos    : Natural;
               begin
                  Flush;
                  Start_Pos := Length (Results) + 1;

                  Analyze (T.I_Block,
                           Parse_State'(State.F_Params'Length,
                             Cursor        => State.Cursor,
                             Max_Lines     => State.Max_Lines,
                             Max_Expand    => State.Max_Expand,
                             Reverse_Index => State.Reverse_Index,
                             Table_Level   => State.Table_Level,
                             Inline_Sep    => T.Sep,
                             Filename      => State.Filename,
                             Line          => T.Line,
                             Blocks_Count  => State.Blocks_Count,
                             I_Params      => State.I_Params,
                             F_Params      => State.F_Params,
                             Block         => State.Block,
                             Terse_Table   => State.Terse_Table,
                             Parent        => L_State'Unchecked_Access));

                  Flush;
                  End_Pos := Length (Results);

                  if Start_Pos < End_Pos then
                     Replace_Slice
                       (Results, Start_Pos, End_Pos,
                        Rewrite_Inlined_Block
                          (T, Slice (Results, Start_Pos, End_Pos)));
                  end if;
               end;

               Analyze (T.Next, State);
         end case;
      end Analyze;

      -----------
      -- Flush --
      -----------

      procedure Flush is
      begin
         Append (Results, Buffer (1 .. Last));
         Last := 0;
      end Flush;

      T : Static_Tree;

   begin
      T := Load (Filename, Cached);

      Now := Ada.Calendar.Clock;
      --  Used for the time related variable

      --  Fill the Unused_Variables set with all variables

      for A in Translations.Set.Iterate loop
         Unused_Variables.Include (Association_Map.Key (A));
      end loop;

      declare
         State : Parse_State := Empty_State;
      begin
         State.Filename := To_Unbounded_String (Filename);
         State.Line := T.Info.Line;
         Analyze (T.C_Info, State);
      end;

      if Cached then
         Cached_Files.Release (T);
      else
         Release (T.Info);
      end if;

      --  Flush buffer and return result

      Flush;

      --  Now report all unused variables

      if Report /= null then
         for V of Unused_Variables loop
            Report (V, Reason => Unused);
         end loop;
      end if;

      return Results;
   end Parse;

   --------------------------
   -- Print_Defined_Macros --
   --------------------------

   procedure Print_Defined_Macros is
   begin
      Macro.Print_Defined_Macros;
   end Print_Defined_Macros;

   ----------------
   -- Print_Tree --
   ----------------

   procedure Print_Tree (T : Tree; Level : Natural := 0) is separate;

   procedure Print_Tree (Filename : String) is
      T : Static_Tree;
   begin
      T := Load (Filename);
      Print_Tree (T.Info);
      Release (T.Info);
   end Print_Tree;

   -----------
   -- Quote --
   -----------

   function Quote (Str : String) return String is
      K : constant Natural := Strings.Fixed.Index (Str, " ");
   begin
      if K = 0 and then Str'Length > 0 then
         return Str;
      else
         return '"' & Str & '"';
      end if;
   end Quote;

   ---------------------
   -- Register_Filter --
   ---------------------

   procedure Register_Filter
     (Name    : String;
      Handler : Callback) renames Filter.Register;

   procedure Register_Filter
     (Name    : String;
      Handler : Callback_No_Param) renames Filter.Register;

   procedure Register_Filter
     (Name   : String;
      Filter : not null access User_Filter'Class) renames Filter.Register;

   procedure Free_Filters renames Filter.Free_Filters;

   -----------
   -- Macro --
   -----------

   procedure Register_Macro_Handler (Callback : Macro_Callback) is
   begin
      Macro.Callback := Callback;
   end Register_Macro_Handler;

   -------------
   -- Release --
   -------------

   procedure Release (T : in out Tree; Include : Boolean := True) is

      procedure Release (Included : in out Included_File_Info);
      --  Release for Included

      -------------
      -- Release --
      -------------

      procedure Release (Included : in out Included_File_Info) is
      begin
         if Include then
            Release (Included.File.Info, Include);

            for K in Included.Params'Range loop
               Data.Release (Included.Params (K));
            end loop;

            Data.Unchecked_Free (Included.Params);

            Data.Release (Included.Filename);
         end if;
      end Release;

   begin
      if T = null then
         return;
      end if;

      case T.Kind is
         when Info =>
            declare
               I : Tree := T.I_File;
               O : Tree;
            begin
               while I /= null loop
                  O := I;
                  I := I.Next;
                  Unchecked_Free (O);
               end loop;
            end;

            Release (T.Next, Include);

         when C_Info =>
            Release (T.Next, Include);

         when Text =>
            declare
               N   : Tree := T;
               Tmp : Tree;
            begin
               --  Handles all consecutive Text nodes

               while N /= null and then N.Kind = Text loop
                  Data.Release (N.Text);
                  Tmp := N;
                  N := N.Next;
                  Unchecked_Free (Tmp);
               end loop;

               Release (N, Include);
            end;

            T := null;
            --  T has been freed, we set the pointer to null to avoid double
            --  deallocation by the call to Free at the end of this routine.

         when Set_Stmt =>
            Definitions.Release (T.Def);
            Release (T.Next, Include);

         when If_Stmt  =>
            Expr.Release (T.Cond);
            Release (T.N_True, Include);
            Release (T.N_False, Include);
            Release (T.Next, Include);

         when Table_Stmt =>
            Release (T.Blocks, Include);
            Release (T.Next, Include);

         when Section_Block =>
            Release (T.Sections, Include);
            Release (T.Common, Include);
            Release (T.Next, Include);

         when Extends_Stmt =>
            Release (T.N_Extends, Include);
            Release (T.E_Included);
            Release (T.Next, Include);

         when Block_Stmt =>
            Release (T.N_Block, Include);

         when Section_Stmt =>
            Release (T.Next, Include);
            Release (T.N_Section, Include);

         when Include_Stmt =>
            Release (T.I_Included);
            Release (T.Next, Include);

         when Inline_Stmt =>
            Release (T.I_Block, Include);
            Release (T.Next, Include);
      end case;

      Unchecked_Free (T);
   end Release;

   -------------------
   -- Release_Cache --
   -------------------

   procedure Release_Cache is
   begin
      Cached_Files.Release;
   end Release_Cache;

   ------------
   -- Remove --
   ------------

   procedure Remove (Set : in out Translate_Set; Name : String) is
   begin
      if Set.Set.Contains (Name) then
         Set.Set.Delete (Name);
      end if;
   end Remove;

   -------------------
   -- Set_Separator --
   -------------------

   procedure Set_Separator (T : in out Tag; Separator : String) is
   begin
      T.Data.Separator := To_Unbounded_String (Separator);
   end Set_Separator;

   ------------------------
   -- Set_Tag_Separators --
   ------------------------

   procedure Set_Tag_Separators
     (Start_With : String := Default_Begin_Tag;
      Stop_With  : String := Default_End_Tag) is
   begin
      Begin_Tag := To_Unbounded_String (Start_With);
      End_Tag   := To_Unbounded_String (Stop_With);
   end Set_Tag_Separators;

   ----------
   -- Size --
   ----------

   function Size (T : Tag) return Natural is
   begin
      return T.Data.Count;
   end Size;

   function Size (Set : Translate_Set) return Natural is
   begin
      return Natural (Set.Set.Length);
   end Size;

   -------------------
   -- Tag_From_Name --
   -------------------

   function Tag_From_Name (Name : String) return String is
   begin
      return To_String (Begin_Tag) & Name & To_String (End_Tag);
   end Tag_From_Name;

   ------------
   -- To_Set --
   ------------

   function To_Set (Table : Translate_Table) return Translate_Set is
      Set : Translate_Set;
   begin
      for K in Table'Range loop
         Insert (Set, Table (K));
      end loop;
      return Set;
   end To_Set;

   ---------------
   -- Translate --
   ---------------

   function Translate
     (Template     : String;
      Translations : Translate_Table := No_Translation) return String is
   begin
      return Translate (Template, To_Set (Translations));
   end Translate;

   function Translate
     (Template     : String;
      Translations : Translate_Set) return String
   is
      T : Data.Tree := Data.Parse (Template, 1);
      P : Data.Tree := T;

      Results : Unbounded_String;

      function Translate (Var : Data.Tag_Var) return String;
      --  Returns translation for Var

      ---------------
      -- Translate --
      ---------------

      function Translate (Var : Data.Tag_Var) return String is
         Pos : Association_Map.Cursor;
         C   : aliased Filter.Filter_Context :=
                 (0, Translations, null, No_Parameter);
      begin
         --  ??? we should probably handle macros there too
         Pos := Translations.Set.Find (To_String (Var.Name));

         if Association_Map.Has_Element (Pos) then
            declare
               Item : constant Association := Association_Map.Element (Pos);
            begin
               case Item.Kind is
                  when Std =>
                     return Data.Translate
                       (Var, To_String (Item.Value), C'Access);
                  when others =>
                     return "";
               end case;
            end;
         end if;

         return "";
      end Translate;

      use type Data.Tree;

   begin
      while P /= null loop
         case P.Kind is
            when Data.Text => Append (Results, P.Value);
            when Data.Var  => Append (Results, Translate (P.Var));
         end case;

         P := P.Next;
      end loop;

      Data.Release (T);

      return To_String (Results);
   end Translate;

   -------------
   -- Version --
   -------------

   function Version return String is separate;
   --  so that it can be generated at build time

end Templates_Parser;