agpl_1.0.0_b5da3320/3rdparty/aws/include/templates_parser.adb

------------------------------------------------------------------------------
--                             Templates Parser                             --
--                                                                          --
--                        Copyright (C) 1999 - 2003                         --
--                               Pascal Obry                                --
--                                                                          --
--  This library is free software; you can redistribute it and/or modify    --
--  it under the terms of the GNU General Public License as published by    --
--  the Free Software Foundation; either version 2 of the License, 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.  See the GNU       --
--  General Public License for more details.                                --
--                                                                          --
--  You should have received a copy of the GNU General Public License       --
--  along with this library; if not, write to the Free Software Foundation, --
--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --
--                                                                          --
--  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.                                     --
------------------------------------------------------------------------------

--  $Id: templates_parser.adb,v 1.3 2004/02/24 15:49:33 Jano Exp $

with Ada.Exceptions;
with Ada.Characters.Handling;
with Ada.Calendar;
with Ada.IO_Exceptions;
with Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants;
with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;

with GNAT.Calendar.Time_IO;
with GNAT.OS_Lib;
with GNAT.Regexp;

with Templates_Parser.Input;

with Text_io; use Text_io;

package body Templates_Parser is

   use Ada;
   use Ada.Exceptions;
   use Ada.Strings;

   Internal_Error : exception;

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

   function Image (N : in Integer) return String;
   pragma Inline (Image);
   --  Returns N image without leading blank

   function No_Quote (Str : in 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.

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

   function Image (N : in Integer) return String is
      N_Img : constant String := Integer'Image (N);
   begin
      if N_Img (N_Img'First) = '-' then
         return N_Img;
      else
         return N_Img (N_Img'First + 1 .. N_Img'Last);
      end if;
   end Image;

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

   function No_Quote (Str : in String) return String is
   begin
      if 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;

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

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

   Table_Token                : constant String := "@@TABLE@@";
   Terminate_Sections_Token   : constant String := "@@TERMINATE_SECTIONS@@";
   Section_Token              : constant String := "@@SECTION@@";
   End_Table_Token            : constant String := "@@END_TABLE@@";
   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@@";

   ------------
   -- 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 "/")

         Add,
         --  Add the given parameter to the string

         BR_2_LF,
         --  Replaces all <BR> HTML tag by a LF character.

         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.

         Div,
         --  Divide the given parameter to the string

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

         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.

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

         Mult,
         --  Multiply the given parameter to the string

         No_Digit,
         --  Replace all digits by spaces.

         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.

         Invert,
         --  Reverse string.

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

         Slice,
         --  Returns a slice of the string.

         Sub,
         --  Substract the given parameter to the string

         Trim,
         --  Trim leading and trailing space.

         Upper,
         --  Upper case.

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

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

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

      type Parameter_Mode is (Void, Str, Regexp, Slice);

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

      type Parameter_Data (Mode : Parameter_Mode := Void) is record
         case Mode is
            when Void =>
               null;

            when Str =>
               S : Unbounded_String;

            when Regexp =>
               R_Str  : Unbounded_String;
               Regexp : GNAT.Regexp.Regexp;

            when Slice =>
               First : Natural;
               Last  : Natural;
         end case;
      end record;

      No_Parameter : constant Parameter_Data := Parameter_Data'(Mode => Void);

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

      type Callback is
        access function (S : in String; P : in 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;

      type String_Access is access constant String;

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

      --  filter functions, see above.

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

      function BR_2_LF
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Capitalize
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Clean_Text
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Coma_2_Point
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Contract
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Exist
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Format_Number
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Is_Empty
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function LF_2_BR
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Lower
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Match
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function No_Digit
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function No_Letter
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function No_Space
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Oui_Non
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Point_2_Coma
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Repeat
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Reverse_Data
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Size
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Slice
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Trim
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Upper
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Web_Escape
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Web_NBSP
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Yes_No
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Plus
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Minus
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Divide
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Multiply
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

      function Modulo
        (S : in String; P : in Parameter_Data := No_Parameter) return String;

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

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

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

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

   end Filter;

   --------------------
   --  Tags variable --
   --------------------

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

   type Tag is record
      Name    : Unbounded_String;
      Filters : Filter.Set_Access;
      Attr    : Attribute := Nil;
   end record;

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

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

   function Translate (T : in Tag; Value : in String) return String;
   --  Returns the result of Value after applying all filters for tag T.

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

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

   function Image (T : in Tag) return String is
      use type Filter.Set_Access;
      R : Unbounded_String;
   begin
      R := Begin_Tag;

      --  Filters

      if T.Filters /= null then
         for K in reverse T.Filters'Range loop
            Append (R, Filter.Name (T.Filters (K).Handle));
            Append (R, Filter.Image (T.Filters (K).Parameters));
            Append (R, ":");
         end loop;
      end if;

      --  Tag name

      Append (R, T.Name);

      --  Attributes

      case T.Attr is
         when Nil        => null;
         when Length     => Append (R, "'Length");
         when Line       => Append (R, "'Line");
         when Min_Column => Append (R, "'Min_Column");
         when Max_Column => Append (R, "'Max_Column");
      end case;

      Append (R, End_Tag);

      return To_String (R);
   end Image;

   -----------
   -- Build --
   -----------

   function Build (Str : in String) return Tag is

      function Get_Var_Name (Tag : in String) return Unbounded_String;
      --  Given a Tag name, it returns the variable name only. It removes
      --  the tag separator and the filters.

      function Get_Filter_Set (Tag : in String) return Filter.Set_Access;
      --  Given a tag name, it retruns a set of filter to apply to this
      --  variable when translated.

      function Get_Attribute (Tag : in String) return Attribute;
      --  Returns attribute for the given tag.

      F_Sep : constant Natural
        := Strings.Fixed.Index (Str, ":", Strings.Backward);
      --  Last filter separator

      A_Sep : constant Natural
        := Strings.Fixed.Index (Str, "'", Strings.Backward);
      --  Attribute separator

      -------------------
      -- Get_Attribute --
      -------------------

      function Get_Attribute (Tag : in String) return Attribute is
         Start, Stop : Natural;
      begin
         if A_Sep = 0 then
            return Nil;
         else
            Start := A_Sep + 1;
            Stop  := Tag'Last - Length (End_Tag);
         end if;

         declare
            A_Name : constant String
              := Characters.Handling.To_Lower (Tag (Start .. Stop));
         begin
            if A_Name = "length" then
               return Length;

            elsif A_Name = "line" then
               return Line;

            elsif A_Name = "min_column" then
               return Min_Column;

            elsif A_Name = "max_column" then
               return Max_Column;

            else
               Exceptions.Raise_Exception
                 (Template_Error'Identity,
                  "Unknown attribute name """ & A_Name & '"');
            end if;
         end;
      end Get_Attribute;

      --------------------
      -- Get_Filter_Set --
      --------------------

      function Get_Filter_Set (Tag : in String) return Filter.Set_Access is

         Start : Natural;
         Stop  : Natural := Tag'Last;
         FS    : Filter.Set (1 .. Strings.Fixed.Count (Tag, ":"));
         K     : Positive := FS'First;

         function Name_Parameter (Filter : in String) return
           Templates_Parser.Filter.Routine;
         --  Given a Filter description, returns the filter handle and
         --  parameter.

         procedure Get_Slice (Slice : in String; First, Last : out Natural);
         --  Returns the First and Last slice index as parsed into the Slice
         --  string. Retruns First and Last set to 0 if there is not valid
         --  slice definition in Slice.

         ---------------
         -- Get_Slice --
         ---------------

         procedure Get_Slice (Slice : in String; First, Last : out Natural) is
            P1 : constant Natural := Fixed.Index (Slice, "..");
         begin
            First := 0;
            Last  := 0;

            if P1 = 0 then
               Exceptions.Raise_Exception
                 (Template_Error'Identity, "slice expected """ & Slice & '"');

            else
               First := Natural'Value (Slice (Slice'First .. P1 - 1));
               Last  := Natural'Value (Slice (P1 + 2 .. Slice'Last));
            end if;
         end Get_Slice;

         --------------------
         -- Name_Parameter --
         --------------------

         function Name_Parameter (Filter : in String) return
           Templates_Parser.Filter.Routine is
            use Strings;

            package F renames Templates_Parser.Filter;

            P1 : constant Natural := Fixed.Index (Filter, "(");
            P2 : constant Natural := Fixed.Index (Filter, ")", Backward);
         begin
            if (P1 = 0 and then P2 /= 0) or else (P1 /= 0 and then P2 = 0) then
               Exceptions.Raise_Exception
                 (Template_Error'Identity,
                  "unbalanced parenthesis """ & Filter & '"');

            elsif P2 /= 0
              and then P2 < Filter'Last
              and then Filter (P2 + 1) /= ':'
            then
               Exceptions.Raise_Exception
                 (Template_Error'Identity,
                  "unexpected character after parenthesis """ & Filter & '"');
            end if;

            if P1 = 0 then
               --  No parenthesis, so there is no parameter to parse
               return (F.Handle (Filter),
                       F.Parameter_Data'(Mode => F.Void));

            else
               declare
                  Name : constant String
                    := Filter (Filter'First .. P1 - 1);

                  Mode : constant F.Mode := F.Mode_Value (Name);

                  Parameter : constant String
                    := No_Quote (Filter (P1 + 1 .. P2 - 1));
               begin
                  case F.Parameter (Mode) is
                     when F.Regexp =>
                        return (F.Handle (Mode),
                                F.Parameter_Data'
                                  (F.Regexp,
                                   To_Unbounded_String (Parameter),
                                   GNAT.Regexp.Compile (Parameter)));

                     when F.Slice =>
                        declare
                           First, Last : Natural;
                        begin
                           Get_Slice (Parameter, First, Last);

                           return (F.Handle (Mode),
                                   F.Parameter_Data'(F.Slice, First, Last));
                        end;

                     when F.Str =>
                        return (F.Handle (Mode),
                                F.Parameter_Data'
                                  (F.Str,
                                   To_Unbounded_String (Parameter)));

                     when F.Void =>
                        pragma Warnings (Off);
                        null;
                  end case;
               end;
            end if;
         end Name_Parameter;

      begin
         if FS'Length = 0 then
            return null;
         end if;

         loop
            Start := Tag'First;

            Stop := Strings.Fixed.Index
              (Tag (Start .. Stop), ":", Strings.Backward);

            exit when Stop = 0;

            Start := Strings.Fixed.Index
              (Tag (Start .. Stop - 1), ":", Strings.Backward);

            if Start = 0 then
               --  Last filter found
               FS (K) := Name_Parameter
                 (Tag (Tag'First + Length (Begin_Tag) .. Stop - 1));
            else
               FS (K) := Name_Parameter (Tag (Start + 1 .. Stop - 1));
            end if;

            K := K + 1;

            Stop := Stop - 1;
         end loop;

         return new Filter.Set'(FS);
      end Get_Filter_Set;

      ------------------
      -- Get_Var_Name --
      ------------------

      function Get_Var_Name (Tag : in String) return Unbounded_String is
         Start, Stop : Natural;
      begin
         if A_Sep = 0 then
            --  No attribute
            Stop := Tag'Last - Length (End_Tag);
         else
            Stop := A_Sep - 1;
         end if;

         if F_Sep = 0 then
            --  No filter
            Start := Tag'First + Length (Begin_Tag);
         else
            Start := F_Sep + 1;
         end if;

         return To_Unbounded_String (Tag (Start .. Stop));
      end Get_Var_Name;

   begin
      return (Get_Var_Name (Str), Get_Filter_Set (Str), Get_Attribute (Str));
   end Build;

   -------------
   -- Release --
   -------------

   procedure Release (T : in out Tag) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Filter.Set, Filter.Set_Access);
   begin
      Free (T.Filters);
   end Release;

   ---------------
   -- Translate --
   ---------------

   function Translate (T : in Tag; Value : in String) return String is
      use type Filter.Set_Access;
   begin
      if T.Filters /= null then
         declare
            R : Unbounded_String := To_Unbounded_String (Value);
         begin
            for K in T.Filters'Range loop
               R := To_Unbounded_String
                 (T.Filters (K).Handle (To_String (R),
                                        T.Filters (K).Parameters));
            end loop;

            return To_String (R);
         end;
      end if;

      return Value;
   end Translate;

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

   package Data is

      type Node;
      type Tree is access Node;

      type NKind is (Text, Var);

      type Node (Kind : NKind) is record
         Next : Tree;
         case Kind is
            when Text =>
               Value : Unbounded_String;
            when Var =>
               Var   : Tag;
         end case;
      end record;

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

      procedure Print_Tree (D : in 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.

   end Data;

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

   package Expr is

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

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

      function Value (O : in String) return Ops;
      --  Returns Ops from its string representation. Raises Templates_Error if
      --  the token is not a known operation.

      type U_Ops is (O_Not);

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

      function Value (O : in String) return U_Ops;
      --  Returns U_Ops from its string representation. Raises Templates_Error
      --  if the token is not a known operation.

      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
         case Kind is
            when Value =>
               V   : Unbounded_String;

            when Var =>
               Var : Tag;

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

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

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

      procedure Print_Tree (E : in 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);
      --  Release all associated memory with the tree.

   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
                  If_Stmt,       --  an IF tag statement
                  Table_Stmt,    --  a TABLE tag statement
                  Section_Stmt,  --  a TABLE section
                  Include_Stmt); --  an INCLUDE tag statement

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

   --  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.

   type Node;
   type Tree is access Node;

   --  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;

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

      case Kind is
         when Info =>
            Filename  : Unbounded_String;    --  Name of the file
            Timestamp : GNAT.OS_Lib.OS_Time; --  Date and Time of last change
            I_File    : Tree;                --  Included file references

            --  Used for the cache system

            Ref       : Natural := 0;        --  Number of ref in the cache

         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 If_Stmt =>
            Cond      : Expr.Tree;
            N_True    : Tree;
            N_False   : Tree;

         when Table_Stmt =>
            Terminate_Sections : Boolean;
            Sections           : Tree;

         when Section_Stmt =>
            N_Section : Tree;

         when Include_Stmt =>
            File : Static_Tree;
      end case;
   end record;

   procedure Release (T : in out Tree);
   --  Release all memory associated with the tree.

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

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

   --  Cached_Files keep the parsed Tree for a given file in memory. This
   --  implementation is thread safe so it is possible to use the cache in a
   --  multitasking program.

   package Cached_Files is

      protected Prot is

         procedure Add
           (Filename : in     String;
            T        : in     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. Furthemore
         --  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 : in     String;
            Load     : in     Boolean;
            Result   :    out Static_Tree);
         --  Returns the Tree for Filename or null if Filename has not been
         --  cached. Load must be set to True at load stage and False at Parse
         --  stage.

         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.

      end Prot;

   end Cached_Files;

   ----------------
   -- Vector_Tag --
   ----------------

   procedure Field
     (Vect   : in     Vector_Tag;
      N      : in     Positive;
      Result :    out Unbounded_String;
      Found  :    out Boolean);
   --  Returns the Nth value in the vector tag. Found is set to False if
   --  N > Vect_Value'Last.

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

   function "+" (Value : in String) return Vector_Tag is
      Item : constant Vector_Tag_Node_Access
        := new Vector_Tag_Node'(To_Unbounded_String (Value), null);
   begin
      return Vector_Tag'
        (Ada.Finalization.Controlled with
           Ref_Count => new Integer'(1),
           Count     => 1,
           Head      => Item,
           Last      => Item,
           Current   => new Vector_Tag_Node_Access'(Item),
           Pos       => new Integer'(1));
   end "+";

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

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

   function "+" (Value : in Strings.Unbounded.Unbounded_String)
     return Vector_Tag is
   begin
      return +To_String (Value);
   end "+";

   function "+" (Value : in Integer) return Vector_Tag is
   begin
      return +Image (Value);
   end "+";

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

   function "&"
     (Vect  : in Vector_Tag;
      Value : in String)
      return Vector_Tag
   is
      Item : constant Vector_Tag_Node_Access
        := new Vector_Tag_Node'(To_Unbounded_String (Value), null);
   begin
      Vect.Ref_Count.all := Vect.Ref_Count.all + 1;

      if Vect.Count = 0 then
         return Vector_Tag'
           (Ada.Finalization.Controlled with
            Ref_Count => Vect.Ref_Count,
            Count     => 1,
            Head      => Item,
            Last      => Item,
            Current   => new Vector_Tag_Node_Access'(Item),
            Pos       => Vect.Pos);
      else
         Vect.Last.Next := Item;
         return Vector_Tag'
           (Ada.Finalization.Controlled with
            Ref_Count => Vect.Ref_Count,
            Count     => Vect.Count + 1,
            Head      => Vect.Head,
            Last      => Item,
            Current   => Vect.Current,
            Pos       => Vect.Pos);
      end if;
   end "&";

   function "&"
     (Vect  : in Vector_Tag;
      Value : in Character)
      return Vector_Tag is
   begin
      return Vect & String'(1 => Value);
   end "&";

   function "&"
     (Vect  : in Vector_Tag;
      Value : in Boolean)
      return Vector_Tag is
   begin
      return Vect & Boolean'Image (Value);
   end "&";

   function "&"
     (Vect  : in Vector_Tag;
      Value : in Strings.Unbounded.Unbounded_String)
      return Vector_Tag is
   begin
      return Vect & To_String (Value);
   end "&";

   function "&"
     (Vect  : in Vector_Tag;
      Value : in Integer)
      return Vector_Tag is
   begin
      return Vect & Image (Value);
   end "&";

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

   procedure Clear (Vect : in out Vector_Tag) is
   begin
      --  Here we just separate current vector from the new one. The memory
      --  used by the current one will be collected by the Finalize
      --  routine. We just want a new independant Vector_Tag here.

      Finalize (Vect);

      Vect.Ref_Count := new Integer'(1);
      Vect.Pos       := new Integer'(1);
      Vect.Count     := 0;
      Vect.Head      := null;
      Vect.Last      := null;
      Vect.Current   := null;
   end Clear;

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

   procedure Adjust (V : in out Vector_Tag) is
   begin
      V.Ref_Count.all := V.Ref_Count.all + 1;
   end Adjust;

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

   procedure Initialize (V : in out Vector_Tag) is
   begin
      V.Ref_Count := new Integer'(1);
      V.Pos       := new Integer'(1);
      V.Count     := 0;
   end Initialize;

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

   function Item (Vect : in Vector_Tag; N : in Positive) return String is
      Result : Unbounded_String;
      Found  : Boolean;
   begin
      Field (Vect, N, Result, Found);

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

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

   procedure Finalize (V : in out Vector_Tag) is
   begin
      V.Ref_Count.all := V.Ref_Count.all - 1;

      if V.Ref_Count.all = 0 then
         declare
            procedure Free is new Ada.Unchecked_Deallocation
              (Vector_Tag_Node, Vector_Tag_Node_Access);

            procedure Free is new Ada.Unchecked_Deallocation
              (Vector_Tag_Node_Access, Access_Vector_Tag_Node_Access);

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

            P, N : Vector_Tag_Node_Access;
         begin
            P := V.Head;

            while P /= null loop
               N := P.Next;
               Free (P);
               P := N;
            end loop;

            V.Head := null;
            V.Last := null;

            Free (V.Ref_Count);
            Free (V.Pos);
            Free (V.Current);
         end;
      end if;
   end Finalize;

   ----------
   -- Size --
   ----------

   function Size (Vect : in Vector_Tag) return Natural is
   begin
      return Vect.Count;
   end Size;

   ----------------
   -- Matrix_Tag --
   ----------------

   procedure Field
     (Matrix : in     Matrix_Tag;
      I, J   : in     Natural;
      Result :    out Unbounded_String;
      Found  :    out Boolean);
   --  Returns Value in Mat_Value (I, J). Found is set to False if there is
   --  no such value in Mat_Value.

   procedure Vector
     (Matrix : in     Matrix_Tag;
      N      : in     Positive;
      Vect   :    out Vector_Tag;
      Found  :    out Boolean);
   --  Returns Vect in Matrix (N). Found is set to False if there is no such
   --  vector in Matrix.

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

   function "+" (Vect : in Vector_Tag) return Matrix_Tag is
      Item : constant Matrix_Tag_Node_Access
        := new Matrix_Tag_Node'(Vect, null);
      V_Size : constant Natural := Size (Vect);
   begin
      return Matrix_Tag'
        (M => (Ada.Finalization.Controlled with
                 Ref_Count => New Integer'(1),
                 Count     => 1,
                 Min       => V_Size,
                 Max       => V_Size,
                 Head      => Item,
                 Last      => Item,
                 Current   => new Matrix_Tag_Node_Access'(Item),
                 Pos       => new Integer'(1)));
   end "+";

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

   function "&"
     (Matrix : in Matrix_Tag;
      Vect   : in Vector_Tag)
      return Matrix_Tag
   is
      Item : constant Matrix_Tag_Node_Access
        := new Matrix_Tag_Node'(Vect, null);
      V_Size : constant Natural := Size (Vect);
   begin
      Matrix.M.Ref_Count.all := Matrix.M.Ref_Count.all + 1;

      if Matrix.M.Head = null then
         return (M => (Ada.Finalization.Controlled with
                       Matrix.M.Ref_Count,
                       Matrix.M.Count + 1,
                       Min     => Natural'Min (Matrix.M.Min, V_Size),
                       Max     => Natural'Max (Matrix.M.Max, V_Size),
                       Head    => Item,
                       Last    => Item,
                       Current => new Matrix_Tag_Node_Access'(Item),
                       Pos     => Matrix.M.Pos));
      else
         Matrix.M.Last.Next := Item;
         return (M => (Ada.Finalization.Controlled with
                       Matrix.M.Ref_Count,
                       Matrix.M.Count + 1,
                       Min     => Natural'Min (Matrix.M.Min, V_Size),
                       Max     => Natural'Max (Matrix.M.Max, V_Size),
                       Head    => Matrix.M.Head,
                       Last    => Item,
                       Current => Matrix.M.Current,
                       Pos     => Matrix.M.Pos));
      end if;
   end "&";

   ----------
   -- Size --
   ----------

   function Size (Matrix : in Matrix_Tag) return Natural is
   begin
      return Matrix.M.Count;
   end Size;

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

   procedure Initialize (M : in out Matrix_Tag_Int) is
   begin
      M.Ref_Count := new Integer'(1);
      M.Pos       := new Integer'(1);
      M.Count     := 0;
      M.Min       := Natural'Last;
      M.Max       := 0;
   end Initialize;

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

   procedure Finalize (M : in out Matrix_Tag_Int) is
   begin
      M.Ref_Count.all := M.Ref_Count.all - 1;

      if M.Ref_Count.all = 0 then
         declare
            procedure Free is new Ada.Unchecked_Deallocation
              (Matrix_Tag_Node, Matrix_Tag_Node_Access);

            procedure Free is new Ada.Unchecked_Deallocation
              (Matrix_Tag_Node_Access, Access_Matrix_Tag_Node_Access);

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

            P, N : Matrix_Tag_Node_Access;
         begin
            P := M.Head;

            while P /= null loop
               N := P.Next;
               Free (P);
               P := N;
            end loop;

            M.Head := null;
            M.Last := null;

            Free (M.Ref_Count);
            Free (M.Pos);
            Free (M.Current);
         end;
      end if;
   end Finalize;

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

   procedure Adjust (M : in out Matrix_Tag_Int) is
   begin
      M.Ref_Count.all := M.Ref_Count.all + 1;
   end Adjust;

   ------------
   -- Vector --
   ------------

   procedure Vector
     (Matrix : in     Matrix_Tag;
      N      : in     Positive;
      Vect   :    out Vector_Tag;
      Found  :    out Boolean) is
   begin
      Found := True;

      if N = Matrix.M.Count then
         Vect := Matrix.M.Last.Vect;

      elsif N >= Matrix.M.Pos.all then

         for K in 1 .. N - Matrix.M.Pos.all loop
            Matrix.M.Pos.all     := Matrix.M.Pos.all + 1;
            Matrix.M.Current.all := Matrix.M.Current.all.Next;
         end loop;

         Vect := Matrix.M.Current.all.Vect;

      elsif N > Matrix.M.Count then
         Found  := False;

      else
         declare
            P : Matrix_Tag_Node_Access := Matrix.M.Head;
         begin
            for K in 1 .. N - 1 loop
               P := P.Next;
            end loop;

            Matrix.M.Pos.all     := N;
            Matrix.M.Current.all := P;

            Vect := P.Vect;
         end;
      end if;
   end Vector;

   function Vector
     (Matrix : in Matrix_Tag;
      N      : in Positive)
      return Vector_Tag
   is
      Result : Vector_Tag;
      Found  : Boolean;
   begin
      Vector (Matrix, N, Result, Found);

      if Found then
         return Result;
      else
         Exceptions.Raise_Exception
           (Constraint_Error'Identity, "Index out of range");
      end if;
   end Vector;

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

   package body Cached_Files is separate;

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

   package body Data is separate;

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

   package body Expr is separate;

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

   procedure Field
     (Vect   : in     Vector_Tag;
      N      : in     Positive;
      Result :    out Unbounded_String;
      Found  :    out Boolean) is
   begin
      Found := True;

      if N = Vect.Count then
         Result := Vect.Last.Value;

      elsif N > Vect.Count then
         Result := Null_Unbounded_String;
         Found  := False;

      elsif N >= Vect.Pos.all then

         for K in 1 .. N - Vect.Pos.all loop
            Vect.Pos.all     := Vect.Pos.all + 1;
            Vect.Current.all := Vect.Current.all.Next;
         end loop;

         Result := Vect.Current.all.Value;

      else
         declare
            P : Vector_Tag_Node_Access := Vect.Head;
         begin
            for K in 1 .. N - 1 loop
               P := P.Next;
            end loop;

            Vect.Pos.all     := N;
            Vect.Current.all := P;

            Result := P.Value;
         end;
      end if;
   end Field;

   procedure Field
     (Matrix : in     Matrix_Tag;
      I, J   : in     Natural;
      Result :    out Unbounded_String;
      Found  :    out Boolean) is
   begin
      Found := True;

      if I = Matrix.M.Count then
         Field (Matrix.M.Last.Vect, J, Result, Found);

      elsif I > Matrix.M.Count then
         Result := Null_Unbounded_String;
         Found  := False;

      elsif I >= Matrix.M.Pos.all then

         for K in 1 .. I - Matrix.M.Pos.all loop
            Matrix.M.Pos.all     := Matrix.M.Pos.all + 1;
            Matrix.M.Current.all := Matrix.M.Current.all.Next;
         end loop;

         Field (Matrix.M.Current.all.Vect, J, Result, Found);

      else
         declare
            P : Matrix_Tag_Node_Access := Matrix.M.Head;
         begin
            for K in 1 .. I - 1 loop
               P := P.Next;
            end loop;

            Matrix.M.Pos.all     := I;
            Matrix.M.Current.all := P;

            Field (P.Vect, J, Result, Found);
         end;
      end if;
   end Field;

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

   package body Filter is separate;

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

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

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

   function Assoc
     (Variable  : in String;
      Value     : in Integer)
      return Association
   is
      S_Value : constant String := Integer'Image (Value);
   begin
      return Assoc (Variable, Image (Value));
   end Assoc;

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

   function Assoc
     (Variable  : in String;
      Value     : in Vector_Tag;
      Separator : in String     := Default_Separator)
      return Association is
   begin
      return Association'
        (Vect,
         To_Unbounded_String (Variable),
         Value,
         To_Unbounded_String (Separator));
   end Assoc;

   function Assoc
     (Variable  : in String;
      Value     : in Matrix_Tag;
      Separator : in String     := Default_Separator)
      return Association is
   begin
      return Association'
        (Matrix,
         To_Unbounded_String (Variable),
         Value,
         To_Unbounded_String (Separator));
   end Assoc;

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

   function Load
     (Filename     : in String;
      Cached       : in Boolean := False;
      Include_File : in Boolean := False)
      return Static_Tree
   is

      File   : Input.File_Type;    --  file beeing parsed.

      Buffer : String (1 .. 2048); --  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_Filename : Unbounded_String;
      --  This variable will be set with the name of the include file that was
      --  not possible to load.

      --  Line handling

      procedure Fatal_Error (Message : in String);
      pragma No_Return (Fatal_Error);
      --  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 beeing
      --  separated by a set of blank characters (space or horizontal
      --  tabulation).

      function Get_All_Parameters return String;
      --  Get all parameters on the current line.

      function Is_Stmt (Stmt : in String) return Boolean;
      pragma Inline (Is_Stmt);
      --  Returns True is Stmt is found at the begining of the current line
      --  ignoring leading blank characters.

      function EOF return Boolean;
      pragma Inline (EOF);
      --  Returns True if the end of file has been reach.

      function Build_Include_Pathname
        (Include_Filename : in Unbounded_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.

      procedure Replace_Include_Variables
        (File      : in out Static_Tree;
         Variables : in     String);
      --  Parse the include tree and replace all include variables (numeric
      --  name) with the corresponding value in Variables (a set of space
      --  separated words). The first word in Variables is the include file
      --  name (variable 0), other words are the parameters (variable 1 .. N).

      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_Table,            --  in a table statement
         Parse_Section,          --  in new section
         Parse_Section_Content   --  in section content
        );

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

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

      function Build_Include_Pathname
        (Include_Filename : in Unbounded_String)
         return String
      is
         K : constant Natural
           := Index (Include_Filename, Maps.To_Set ("/\"),
                     Going => Strings.Backward);
      begin
         if K = 0 then
            declare
               K : constant Natural
                 := Fixed.Index (Filename, Maps.To_Set ("/\"),
                                 Going => Strings.Backward);
            begin
               if K = 0 then
                  return To_String (Include_Filename);
               else
                  return Filename (Filename'First .. K)
                    & To_String (Include_Filename);
               end if;
            end;
         else
            return To_String (Include_Filename);
         end if;
      end Build_Include_Pathname;

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

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

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

      procedure Fatal_Error (Message : in String) is
      begin
         Exceptions.Raise_Exception
           (Template_Error'Identity,
            "In " & Filename
            & " at line" & Natural'Image (Line) & ' ' & Message & '.');
      end Fatal_Error;

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

      function Get_All_Parameters return String is
         Start : Natural;
      begin
         Start := Strings.Fixed.Index (Buffer (First .. Last), Blank);

         if Start = 0 then
            Fatal_Error ("missing parameter");
         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), Strings.Both);
      end Get_All_Parameters;

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

      function Get_First_Parameter return Unbounded_String is
         Start, Stop : Natural;
      begin
         Start := Strings.Fixed.Index (Buffer (First .. Last), Blank);

         if Start = 0 then
            return Null_Unbounded_String;
         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
            Line := Line + 1;

            loop
               Input.Get_Line (File, Buffer, Last);
               exit when Buffer (Buffer'First .. Buffer'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;

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

            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;

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

            return False;
         end if;
      end Get_Next_Line;

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

      function Is_Stmt (Stmt : in String) return Boolean is
      begin
         return Last /= 0
           and then Buffer (First .. First + Stmt'Length - 1) = Stmt;
      end Is_Stmt;

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

      function Parse
        (Mode    : in Parse_Mode;
         No_Read : in Boolean := False)
         return Tree
      is
         T : Tree;
      begin
         if not No_Read
           and then (Mode /= Parse_Section and then Mode /= Parse_Elsif)
         then
            if Get_Next_Line then
               return null;
            end if;
         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;

            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_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);

               if Is_Stmt (End_Table_Token) then
                  T.N_Section := null;

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

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

               return T;

            when Parse_Section_Content =>
               if Is_Stmt (Section_Token)
                 or else 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_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;

         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);
            T.N_True := Parse (Parse_If);

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

            elsif Is_Stmt (Elsif_Token) then
               T.N_False := Parse (Parse_Elsif);

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

            else

               T.N_False := Parse (Parse_Else);
            end if;

            T.Next := Parse (Mode);

            return T;

         elsif Is_Stmt (Table_Token) then
            T := new Node (Table_Stmt);

            T.Line := Line;

            T.Terminate_Sections
              := Get_First_Parameter = Terminate_Sections_Token;

            T.Sections := Parse (Parse_Section);
            T.Next     := Parse (Mode);

            return T;

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

            T.Line := Line;

            begin
               T.File
                 := Load (Build_Include_Pathname (Get_First_Parameter),
                          Cached, True);
            exception
               when 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_Filename := Get_First_Parameter;
                  Free (T);
                  return null;
            end;

            --  Now we must replace the include parameters (if present) into
            --  the included file tree.

            Replace_Include_Variables (T.File, Get_All_Parameters);

            I_File := new Node'(Include_Stmt, I_File, Line, T.File);

            T.Next := Parse (Mode);

            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 is the read line with 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);
                  else
                     T.Text := Data.Parse (Buffer (1 .. Last));
                  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)
                    or else Is_Stmt (Section_Token)
                    or else Is_Stmt (End_Table_Token)
                  then
                     T.Next := Parse (Mode, No_Read => True);
                     return Root;
                  end if;
               end loop;
            end;
         end if;
      end Parse;

      -------------------------------
      -- Replace_Include_Variables --
      -------------------------------

      procedure Replace_Include_Variables
        (File      : in out Static_Tree;
         Variables : in     String)
      is
         procedure Replace (T : in out Tree);
         --  Recursive routine to parse the tree for all Data.Tree node

         procedure Replace (T : in out Data.Tree);
         --  Recursive routine that replace all numeric variables by the
         --  corresponding parameter in Variables.

         function Get_Variable (Tag : in String) return String;
         --  Returns the variable name for the include tag Tag. Tag is a
         --  numeric value and represent the Nth include parameter.

         function Is_Number (Name : in String) return Boolean;
         --  Returns True if Name is an include tag variable ($<n>)

         ------------------
         -- Get_Variable --
         ------------------

         function Get_Variable (Tag : in String) return String is
            T : constant Natural
              := Natural'Value (Tag (Tag'First + 1 .. Tag'Last));
            S : Natural := Variables'First;
            E : Natural;
            K : Natural := 0;
         begin
            loop
               if Variables (S) = '"' then
                  --  Search for the ending quote

                  E := Strings.Fixed.Index
                    (Variables (S + 1 .. Variables'Last), """");

                  if E = 0 then
                     Fatal_Error ("Missing quote");
                  else
                     E := E + 1;
                  end if;

               else
                  --  Search for the next separator

                  E := Strings.Fixed.Index
                    (Variables (S .. Variables'Last), Blank);
               end if;

               if E = 0 and then K /= T then
                  --  Not found, return the original tag name
                  return To_String (Begin_Tag) & Tag & To_String (End_Tag);

               elsif K = T then
                  --  We have found the right variable

                  if E = 0 then
                     E := Variables'Last;
                  else
                     E := E - 1;
                  end if;

                  --  Always return the variable or value unquoted

                  if Variables (S) = '"' then
                     return Variables (S + 1  .. E - 1);
                  else
                     return Variables (S .. E);
                  end if;

               else
                  --  Set the new start

                  S := E;

                  S := Strings.Fixed.Index
                    (Variables (S .. Variables'Last), Blank, Strings.Outside);

                  if S = 0 then
                     --  No more values, return the original tag name
                     return To_String (Begin_Tag) & Tag & To_String (End_Tag);
                  end if;
               end if;

               K := K + 1;
            end loop;
         end Get_Variable;

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

         function Is_Number (Name : in String) return Boolean is
         begin
            return Name'Length > 1
              and then Name (Name'First) = '$'
              and then Strings.Fixed.Count
                         (Name, Strings.Maps.Constants.Decimal_Digit_Set)
                       = Name'Length - 1;
         end Is_Number;

         -------------
         -- Replace --
         -------------

         procedure Replace (T : in out Data.Tree) is

            use type Data.NKind;
            use type Data.Tree;
            use type Filter.Set_Access;

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

            Old : Data.Tree := T;

         begin
            if T /= null then
               if T.Kind = Data.Var then
                  if Is_Number (To_String (T.Var.Name)) then
                     --  Here we have an include variable name, replace it

                     T := Data.Parse (Get_Variable (To_String (T.Var.Name)));
                     T.Next := Old.Next;

                     case T.Kind is
                        when Data.Var =>
                           --  The new node is also a variable, inherit all the
                           --  filters and attribute
                           T.Var.Filters := Old.Var.Filters;
                           T.Var.Attr    := Old.Var.Attr;

                        when Data.Text =>
                           --  The new node is a value, apply filters if the
                           --  previous node had some.

                           if Old.Var.Filters /= null then
                              T.Value := To_Unbounded_String
                                (Translate (Old.Var, To_String (T.Value)));
                           end if;

                           --  Free filters
                           Release (Old.Var);
                     end case;

                     --  Free only node
                     Free (Old);
                  end if;
               end if;

               Replace (T.Next);
            end if;
         end Replace;

         -------------
         -- Replace --
         -------------

         procedure Replace (T : in out Expr.Tree) is

            use type Expr.NKind;
            use type Expr.Tree;
            use type Filter.Set_Access;

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

            Old : Expr.Tree := T;

         begin
            if T /= null then

               case T.Kind is
                  when Expr.Var =>
                     if Is_Number (To_String (T.Var.Name)) then
                        --  Here we have an include variable name, replace it

                        declare
                           New_Value : constant String
                             := Get_Variable (To_String (T.Var.Name));
                        begin
                           if Strings.Fixed.Index (New_Value, " ") = 0 then
                              T := Expr.Parse (New_Value);

                           else
                              --  There is some spaces in the new value,
                              --  this can't be a variable so it is a value
                              --  with multiple word, quote it to ensure a
                              --  correct parsing.

                              T := Expr.Parse ('"' & New_Value & '"');
                           end if;
                        end;

                        case T.Kind is
                           when Expr.Var =>
                              --  The new node is also a variable, inherit all
                              --  the filters.
                              T.Var.Filters := Old.Var.Filters;
                              T.Var.Attr    := Old.Var.Attr;

                           when Expr.Value =>
                              --  The new node is a value, apply filters if the
                              --  previous node had some.

                              if Old.Var.Filters /= null then
                                 T.V := To_Unbounded_String
                                   (Translate (Old.Var, To_String (T.V)));
                              end if;

                              --  Free filters
                              Release (Old.Var);

                           when Expr.Op | Expr.U_Op =>
                              --  Should never happen
                              Fatal_Error
                                ("Var or Value node kind expected,"
                                   & " Op or U_Op found ");
                        end case;

                        Free (Old);
                     end if;

                  when Expr.Op =>
                    Replace (T.Left);
                    Replace (T.Right);

                  when Expr.U_Op =>
                     Replace (T.Next);

                  when Expr.Value =>
                     null;

               end case;
            end if;
         end Replace;

         -------------
         -- Replace --
         -------------

         procedure Replace (T : in out Tree) is
            use type Tree;
         begin
            if T /= null then
               case T.Kind is
                  when Text =>
                     Replace (T.Text);

                  when If_Stmt =>
                     Replace (T.Cond);
                     Replace (T.N_True);
                     Replace (T.N_False);

                  when Table_Stmt =>
                     Replace (T.Sections);

                  when Include_Stmt =>
                     Replace (T.File.C_Info);

                  when Section_Stmt =>
                     Replace (T.N_Section);

                  when Info | C_Info =>
                     null;
               end case;

               Replace (T.Next);
            end if;
         end Replace;

      begin
         Replace (File.C_Info);
      end Replace_Include_Variables;

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

   begin
      if Cached then
         Cached_Files.Prot.Get (Filename, Load => True, Result => T);

         if T.Info /= null then
            pragma Assert (T.C_Info /= null);
            return T;
         end if;
      end if;

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

      New_T := Parse (Parse_Std);

      Input.Close (File);

      --  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'(C_Info, New_T, 0, False, 1);

      --  Add first node (info about tree)

      New_T := new Node'(Info,
                         Old,
                         0,
                         To_Unbounded_String (Filename),
                         GNAT.OS_Lib.File_Time_Stamp (Filename),
                         I_File,
                         1);

      if Error_Include_Filename /= 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_Filename) & " include file missing");
      end if;

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

      return Static_Tree'(New_T, Old);

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

   ----------------
   -- Print_Tree --
   ----------------

   procedure Print_Tree (T : in Tree; Level : in Natural := 0) is separate;

   ----------------
   -- Print_Tree --
   ----------------

   procedure Print_Tree (Filename : in String) is
      T : Static_Tree;
   begin
      T := Load (Filename);
      Print_Tree (T.Info);
      Release (T.Info);
   end Print_Tree;

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

   function Parse
     (Filename          : in String;
      Translations      : in Translate_Table := No_Translation;
      Cached            : in Boolean         := False;
      Keep_Unknown_Tags : in Boolean         := False)
      return String is
   begin
      return To_String
        (Parse (Filename, Translations, Cached, Keep_Unknown_Tags));
   end Parse;

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

   function Parse
     (Filename          : in String;
      Translations      : in Translate_Table := No_Translation;
      Cached            : in Boolean         := False;
      Keep_Unknown_Tags : in Boolean         := False)
      return Unbounded_String
   is
      type Table_State is record
         I, J           : Natural;
         Max_Lines      : Natural;
         Max_Expand     : Natural;
         Table_Level    : Natural;
         Section_Number : Natural;
      end record;

      Empty_State : constant Table_State := (0, 0, 0, 0, 0, 0);

      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;

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

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

      procedure Analyze
        (T     : in Tree;
         State : in Table_State)
      is

         function Analyze (E : in 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 : in 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 Get_Max
           (T          : in     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 Is_True (Str : in String) return Boolean;
         --  Return True if Str is one of "TRUE", "OUI", the case beeing not
         --  case sensitive.

         function Translate (Var : in Tag) return String;
         --  Translate Tag variable using Translation table and apply all
         --  Filters and Atribute recorded for this variable.

         ---------------
         -- Translate --
         ---------------

         function Translate (Var : in Tag) return String is

            function Vect_List (A : in Association) return String;
            --  Returns the Vector_Tag for the Association as a String, each
            --  value is separated by the given separator.

            function Vect_Size (A : in Association) return String;
            pragma Inline (Vect_Size);
            --  Returns the number of items into the Vector_Tag

            function Mat_List (A : in Association) return String;
            --  Returns the Matrix_Tag as a string. If Matrix_Tag is not into
            --  a table, each Vector_Tag is convected using Vect_List and a LF
            --  is inserted between each rows. If the Matrix_Tag is into a
            --  table of level 1, it returns only the Vector_Tag (converted
            --  using Vect_List) for the current table line.

            function Mat_Line (A : in Association) return String;
            pragma Inline (Mat_Line);
            --  Returns the number of line (vector) into the matrix

            function Mat_Min_Column (A : in Association) return String;
            pragma Inline (Mat_Line);
            --  Returns the size of the smallest vector

            function Mat_Max_Column (A : in Association) return String;
            pragma Inline (Mat_Line);
            --  Returns the size of the largest vector

            ---------------
            -- Vect_List --
            ---------------

            function Vect_List (A : in Association) return String is
               Result : Unbounded_String;
               P      : Vector_Tag_Node_Access := A.Vect_Value.Head;
            begin
               if P = null then
                  return "";
               else
                  Result := P.Value;
                  for K in 2 .. A.Vect_Value.Count loop
                     P := P.Next;
                     Append (Result, A.Separator & P.Value);
                  end loop;

                  return To_String (Result);
               end if;
            end Vect_List;

            ---------------
            -- Vect_Size --
            ---------------

            function Vect_Size (A : in Association) return String is
            begin
               return Image (A.Vect_Value.Count);
            end Vect_Size;

            --------------
            -- Mat_List --
            --------------

            function Mat_List (A : in Association) return String is
               Result : Unbounded_String;
               P      : Matrix_Tag_Node_Access := A.Mat_Value.M.Head;

               procedure Add_Vector (V : in Vector_Tag);
               --  Add V Vector_Tag representation into Result variable.

               ----------------
               -- Add_Vector --
               ----------------

               procedure Add_Vector (V : in Vector_Tag) is
                  P : Vector_Tag_Node_Access := V.Head;
               begin
                  --  Check that vector is not empty
                  if P /= null then
                     Result := Result & P.Value;

                     for K in 2 .. V.Count loop
                        P := P.Next;
                        Append (Result, A.Column_Separator & P.Value);
                     end loop;
                  end if;
               end Add_Vector;

            begin
               if State.Table_Level = 0 then
                  --  A Matrix outside a table statement.

                  loop
                     Add_Vector (P.Vect);
                     P := P.Next;

                     exit when P = null;

                     Append (Result, ASCII.LF);
                  end loop;

               else
                  if not (State.J > A.Mat_Value.M.Count) then
                     Add_Vector (Vector (A.Mat_Value, State.J));
                  end if;
               end if;

               return To_String (Result);
            end Mat_List;

            --------------
            -- Mat_Line --
            --------------

            function Mat_Line (A : in Association) return String is
            begin
               return Image (A.Mat_Value.M.Count);
            end Mat_Line;

            --------------------
            -- Mat_Min_Column --
            --------------------

            function Mat_Min_Column (A : in Association) return String is
            begin
               return Image (A.Mat_Value.M.Min);
            end Mat_Min_Column;

            --------------------
            -- Mat_Max_Column --
            --------------------

            function Mat_Max_Column (A : in Association) return String is
            begin
               return Image (A.Mat_Value.M.Max);
            end Mat_Max_Column;

         begin
            for K in Translations'Range loop
               if Var.Name = Translations (K).Variable then

                  declare
                     Tk : constant Association := Translations (K);
                  begin
                     case Tk.Kind is

                        when Std =>
                           if Var.Attr = Nil then
                              return Translate (Var, To_String (Tk.Value));
                           else
                              Exceptions.Raise_Exception
                                (Template_Error'Identity,
                                 "Attribute not valid on a discrete tag");
                           end if;

                        when Vect =>
                           if Var.Attr = Length then
                              --  'Length on a vector
                              return Translate (Var, Vect_Size (Tk));

                           elsif Var.Attr /= Nil then
                              Exceptions.Raise_Exception
                                (Template_Error'Identity,
                                 "This attribute is not valid for a "
                                   & "vector tag");

                           elsif State.Table_Level = 0 then
                              --  This is a vector tag (outside of a
                              --  table tag statement), we display it as
                              --  a list separated by the specified
                              --  separator.
                              return Translate (Var, Vect_List (Tk));

                           else
                              declare
                                 Result : Unbounded_String;
                                 Found  : Boolean;
                              begin
                                 Field (Tk.Vect_Value, State.J, Result, Found);
                                 return Translate (Var, To_String (Result));
                              end;
                           end if;

                        when Matrix =>
                           if Var.Attr = Line then
                              --  'Line on a matrix
                              return Translate (Var, Mat_Line (Tk));

                           elsif Var.Attr = Min_Column then
                              --  'Min_Column on a matrix
                              return Translate (Var, Mat_Min_Column (Tk));

                           elsif Var.Attr = Max_Column then
                              --  'Max_Column on a matrix
                              return Translate (Var, Mat_Max_Column (Tk));

                           elsif Var.Attr /= Nil then
                              Exceptions.Raise_Exception
                                (Template_Error'Identity,
                                 "This attribute is not valid for a "
                                   & "matrix tag");

                           elsif State.Table_Level in 0 .. 1 then
                              --  This is a matrix tag (outside of a
                              --  level 2 table tag statement), convert
                              --  it using Mat_List.
                              return Translate (Var, Mat_List (Tk));

                           else
                              declare
                                 Result : Unbounded_String;
                                 Found  : Boolean;
                              begin
                                 Field (Tk.Mat_Value, State.I, State.J,
                                        Result, Found);
                                 return Translate (Var, To_String (Result));
                              end;
                           end if;
                     end case;
                  end;
               end if;
            end loop;

            --  Check now for an internal tag

            declare
               T_Name : constant String := To_String (Var.Name);
            begin

               if T_Name = "UP_TABLE_LINE" then
                  return Translate
                    (Var,
                     Fixed.Trim (Positive'Image (State.I), Strings.Left));

               elsif T_Name = "TABLE_LINE" then
                  return Translate
                    (Var,
                     Fixed.Trim (Positive'Image (State.J), Strings.Left));

               elsif T_Name = "NUMBER_LINE" then
                  return Translate
                    (Var,
                     Fixed.Trim (Positive'Image (State.Max_Lines),
                                 Strings.Left));

               elsif T_Name = "TABLE_LEVEL" then
                  return Translate
                    (Var,
                     Fixed.Trim (Positive'Image (State.Table_Level),
                                 Strings.Left));

               elsif T_Name = "YEAR" then
                  return Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%Y"));

               elsif T_Name = "MONTH" then
                  return Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%m"));

               elsif T_Name = "DAY" then
                  return Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%d"));

               elsif T_Name = "HOUR" then
                  return Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%H"));

               elsif T_Name = "MINUTE" then
                  return Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%M"));

               elsif T_Name = "SECOND" then
                  return Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%S"));

               elsif T_Name = "MONTH_NAME" then
                  return Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%B"));

               elsif T_Name = "DAY_NAME" then
                  return Translate
                    (Var, GNAT.Calendar.Time_IO.Image (Now, "%A"));
               end if;
            end;

            --  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 To_String (Begin_Tag & Var.Name & End_Tag);
            else
               return Translate (Var, "");
            end if;
         end Translate;

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

         procedure Analyze (D : in Data.Tree) is
            use type Data.Tree;

            procedure Add (S : in String);
            --  Add S into Results (using Buffer cache if possible)

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

            procedure Add (S : in String) is
            begin
               if Last + S'Length > Buffer'Last then
                  --  Not enough cache space, flush buffer
                  Append (Results, Buffer (1 .. Last));
                  Last := 0;
               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;

            T : Data.Tree := D;

         begin
            while T /= null loop

               case T.Kind is

                  when Data.Text =>
                     Add (To_String (T.Value));

                  when Data.Var =>
                     Add (Translate (T.Var));

               end case;

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

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

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

            type Ops_Fct is access function (L, R : in String) return String;

            function F_And  (L, R : in String) return String;
            function F_Or   (L, R : in String) return String;
            function F_Xor  (L, R : in String) return String;
            function F_Sup  (L, R : in String) return String;
            function F_Esup (L, R : in String) return String;
            function F_Einf (L, R : in String) return String;
            function F_Inf  (L, R : in String) return String;
            function F_Equ  (L, R : in String) return String;
            function F_Diff (L, R : in String) return String;

            type U_Ops_Fct is access function (N : in String) return String;

            function F_Not (N : in String) return String;

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

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

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

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

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

            function F_Einf (L, R : in String) return String is
            begin
               if Integer'Value (L) <= Integer'Value (R) then
                  return "TRUE";
               else
                  return "FALSE";
               end if;
            exception
               when others =>
                  if L <= R then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;
            end F_Einf;

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

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

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

            function F_Esup (L, R : in String) return String is
            begin
               if Integer'Value (L) >= Integer'Value (R) then
                  return "TRUE";
               else
                  return "FALSE";
               end if;
            exception
               when others =>
                  if L >= R then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;
            end F_Esup;

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

            function F_Inf (L, R : in String) return String is
            begin
               if Integer'Value (L) < Integer'Value (R) then
                  return "TRUE";
               else
                  return "FALSE";
               end if;
            exception
               when others =>
                  if L < R then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;
            end F_Inf;

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

            function F_Not (N : in String) return String is
            begin
               if Is_True (N) then
                  return "FALSE";
               else
                  return "TRUE";
               end if;
            end F_Not;

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

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

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

            function F_Sup (L, R : in String) return String is
            begin
               if Integer'Value (L) > Integer'Value (R) then
                  return "TRUE";
               else
                  return "FALSE";
               end if;
            exception
               when others =>
                  if L > R then
                     return "TRUE";
                  else
                     return "FALSE";
                  end if;
            end F_Sup;

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

            function F_Xor (L, R : in String) return String is
            begin
               if Is_True (L) xor Is_True (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);

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

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

               when Expr.Var =>
                  return Translate (E.Var);

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

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

         -------------
         -- Get_Max --
         -------------

         procedure Get_Max
           (T          : in     Tree;
            Max_Lines  :    out Natural;
            Max_Expand :    out Natural)
         is

            function Get_Max_Lines
              (T : in Tree;
               N : in Positive)
               return Natural;
            --  Recursivelly descend the tree and compute the max lines that
            --  will be displayed into the table.

            function Count_Section return Natural;
            --  Returns the number of section into table T;

            -------------------
            -- Count_Section --
            -------------------

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

            -------------------
            -- Get_Max_Lines --
            -------------------

            function Get_Max_Lines
              (T : in Tree;
               N : in Positive)
               return Natural
            is

               function Check (T : in Data.Tree) return Natural;
               --  Returns the length of the largest vector tag found on the
               --  subtree.

               -----------
               -- Check --
               -----------

               function Check (T : in Data.Tree) return Natural is
                  use type Data.Tree;
                  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.Attr = Nil then

                        for K in Translations'Range loop
                           declare
                              Tk : constant Association := Translations (K);
                           begin
                              if D.Var.Name = Tk.Variable then
                                 if N = 1 then
                                    --  First block level analysed.

                                    if Tk.Kind = Vect then
                                       --  This is a Vector tag into a top
                                       --  level table statement. The number
                                       --  of iterations for this table
                                       --  statement correspond to the number
                                       --  of item into the vector.
                                       Iteration :=
                                         Natural'Max (Iteration,
                                                      Size (Tk.Vect_Value));

                                    elsif Tk.Kind = Matrix then

                                       if State.Table_Level = 0 then
                                          --  This is Matrix tag into a top
                                          --  level table statement. The
                                          --  number of iterations for this
                                          --  table statement correspond to
                                          --  the number of vector into the
                                          --  table.
                                          Iteration :=
                                            Natural'Max (Iteration,
                                                         Size (Tk.Mat_Value));
                                       else
                                          --  This is Matrix tag into an
                                          --  embbeded table statement (table
                                          --  statement into a table
                                          --  statement). The number of
                                          --  iterations for this table
                                          --  statement correspond to the
                                          --  largest number of items in the
                                          --  Matrix tag's vectors.
                                          Iteration := Tk.Mat_Value.M.Max;
                                       end if;
                                    end if;

                                 elsif N = 2 then
                                    --  Second block level analysed.

                                    if Tk.Kind = Matrix then
                                       --  This is a Matrix tag into an
                                       --  embedded table statement (table
                                       --  statement into a table statement)
                                       --  analysed at the second block
                                       --  level. This is to report the number
                                       --  of iterations for upper level table
                                       --  statement. This number of
                                       --  iterations correspond to the
                                       --  smallest number of vectors into the
                                       --  table.
                                       Iteration :=
                                         Natural'Max (Iteration,
                                                      Size (Tk.Mat_Value));
                                    end if;
                                 end if;
                              end if;
                           end;
                        end loop;
                     end if;
                     D := D.Next;
                  end loop;

                  return Iteration;
               end Check;

            begin
               if T = null then
                  return Natural'First;
               end if;

               case T.Kind is
                  when Info | C_Info =>
                     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
                       (Natural'Max (Get_Max_Lines (T.N_True, N),
                                     Get_Max_Lines (T.N_False, N)),
                        Get_Max_Lines (T.Next, N));

                  when Table_Stmt =>
                     if N = 1 then
                        return Natural'Max (Get_Max_Lines (T.Sections, N + 1),
                                            Get_Max_Lines (T.Next, N));
                     else
                        return Natural'First;
                     end if;

                  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.File.Info, N),
                                         Get_Max_Lines (T.Next, N));
               end case;
            end Get_Max_Lines;

            Result : Natural := Get_Max_Lines (T.Sections, 1);

         begin
            pragma Assert (T.Kind = Table_Stmt);

            Max_Lines := Result;

            if T.Terminate_Sections then

               declare
                  N_Section : constant Positive := Count_Section;
               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;

         -------------
         -- Is_True --
         -------------

         function Is_True (Str : in String) return Boolean is
            L_Str : constant String := Characters.Handling.To_Upper (Str);
         begin
            return L_Str = "TRUE";
         end Is_True;

      begin
         if T = null then
            return;
         end if;

         case T.Kind is

            when Info | C_Info =>
               Analyze (T.Next, State);

            when Text =>
               begin
                  Analyze (T.Text);
               exception
                  when E : others =>
                     Exceptions.Raise_Exception
                       (Template_Error'Identity,
                        "In " & Filename
                        & " at line" & Natural'Image (T.Line) & ", "
                        & Exceptions.Exception_Message (E) & '.');
               end;

               Analyze (T.Next, State);

            when If_Stmt  =>
               if Analyze (T.Cond) = "TRUE" then
                  Analyze (T.N_True, State);
               else
                  Analyze (T.N_False, State);
               end if;

               Analyze (T.Next, State);

            when Table_Stmt =>
               declare
                  Max_Lines, Max_Expand : Natural;
               begin
                  Get_Max (T, Max_Lines, Max_Expand);

                  Analyze (T.Sections,
                           Table_State'(State.I, State.J,
                                        Max_Lines, Max_Expand,
                                        State.Table_Level + 1,
                                        State.Section_Number + 1));
               end;

               Analyze (T.Next, State);

            when Section_Stmt =>
               declare
                  First_Section : Tree := T;
                  Current       : Tree := T;
                  Section       : Positive := 1;
               begin

                  for K in 1 .. State.Max_Expand loop
                     Analyze (Current.Next,
                              Table_State'(State.J,
                                           K,
                                           State.Max_Lines, State.Max_Expand,
                                           State.Table_Level, Section));

                     Current := Current.N_Section;
                     Section := Section + 1;

                     if Current = null then
                        Current := First_Section;
                        Section := 1;
                     end if;
                  end loop;
               end;

            when Include_Stmt =>
               Analyze (T.File.Info, State);

               Analyze (T.Next, State);

         end case;
      end Analyze;

      T : Static_Tree;

   begin
      T := Load (Filename, Cached);

      Now := Ada.Calendar.Clock;
      --  Used for the time related variable

      Analyze (T.C_Info, Empty_State);

      if not Cached then
         Release (T.Info);

      else
         Cached_Files.Prot.Release (T);
      end if;

      --  Flush buffer and return result

      Append (Results, Buffer (1 .. Last));

      return Results;
   end Parse;

   -------------
   -- Release --
   -------------

   procedure Release (T : in out Tree) is
   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;
                  Free (O);
               end loop;
            end;

            Release (T.Next);
            Free (T);

         when C_Info =>
            Release (T.Next);
            Free (T);

         when Text =>
            Data.Release (T.Text);
            Release (T.Next);
            Free (T);

         when If_Stmt  =>
            Expr.Release (T.Cond);
            Release (T.N_True);
            Release (T.N_False);
            Release (T.Next);
            Free (T);

         when Table_Stmt =>
            Release (T.Sections);
            Release (T.Next);
            Free (T);

         when Section_Stmt =>
            Release (T.Next);
            Release (T.N_Section);
            Free (T);

         when Include_Stmt =>
            T.File.Info.Ref := T.File.Info.Ref - 1;

            if T.File.Info.Ref = 0 then
               --  No more reference to this include file we release it.
               Release (T.File.Info);
            end if;

            Release (T.Next);
            Free (T);
      end case;
   end Release;

   ------------------------
   -- Set_Tag_Separators --
   ------------------------

   procedure Set_Tag_Separators
     (Start_With : in String := Default_Begin_Tag;
      Stop_With  : in String := Default_End_Tag) is
   begin
      Begin_Tag := To_Unbounded_String (Start_With);
      End_Tag   := To_Unbounded_String (Stop_With);
   end Set_Tag_Separators;

   ---------------
   -- Translate --
   ---------------

   function Translate
     (Template     : in String;
      Translations : in Translate_Table := No_Translation)
      return String
   is
      T : Data.Tree := Data.Parse (Template);
      P : Data.Tree := T;

      Results : Unbounded_String;

      function Translate (Var : in Tag) return String;
      --  Returns translation for Var.

      ---------------
      -- Translate --
      ---------------

      function Translate (Var : in Tag) return String is
      begin
         for K in Translations'Range loop
            if Var.Name = Translations (K).Variable then
               declare
                  Tk : constant Association := Translations (K);
               begin
                  case Tk.Kind is

                     when Std =>
                        return Translate (Var, To_String (Tk.Value));

                     when others =>
                        return "";
                  end case;
               end;
            end if;
         end loop;

         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;

end Templates_Parser;