aflex_1.7.0_77dbb4da/src/template_manager.adb

-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE template manager
-- AUTHOR: John Self (UCI)
-- DESCRIPTION supports output of internalized templates for the IO and DFA
--             packages.
-- NOTES This package is quite a memory hog, and is really only useful on
--       virtual memory systems.  It could use an external file to store the
--       templates like the skeleton manager.  This would save memory at the
--       cost of a slight reduction in speed and the necessity of keeping
--       copies of the template files in a known place.
-- $Header: /dc/uc/self/arcadia/aflex/ada/src/RCS/template_managerB.a,v 1.21 1992/12/29 22:46:15 self Exp self $

--  6-Aug-2008 GdM : Added Input_Line
-- 26-Dec-2006 GdM : Added Output_Column and Output_New_Line

with Ada.Strings.Fixed;
with Ada.Directories;
with Misc_Defs, External_File_Manager, Misc;
with Template_Manager.Templates;
package body Template_Manager is

   use Misc_Defs;
   use Ada;
   use Ada.Text_IO;

   Has_Code : array (Code_Filename) of Boolean := (others => False);

   YYTYPE_CODE_FILENAME   : constant String := "yytype.miq";
   YYDFA_CODE_FILENAME    : constant String := "yydfa.miq";
   YYINIT_CODE_FILENAME   : constant String := "yyinit.miq";
   YYACTION_CODE_FILENAME : constant String := "yyaction.miq";
   YYWRAP_CODE_FILENAME   : constant String := "yywrap.miq";

   function Get_Filename (Code : in Code_Filename) return String is
   begin
      Has_Code (Code) := True;
      case Code is
         when YYTYPE_CODE =>
            return YYTYPE_CODE_FILENAME;

         when YYDFA_CODE =>
            return YYDFA_CODE_FILENAME;

         when YYINIT_CODE =>
            return YYINIT_CODE_FILENAME;

         when YYACTION_CODE =>
            return YYACTION_CODE_FILENAME;

         when YYWRAP_CODE =>
            return YYWRAP_CODE_FILENAME;

      end case;
   end Get_Filename;

   procedure Include_File (Outfile : in File_Type;
                           Filename : in String) is
      Input : File_Type;
   begin
      if not Ada.Directories.Exists (Filename) then
         return;
      end if;
      Open (Input, Ada.Text_IO.In_File, Filename);
      while not End_Of_File (Input) loop
         Put_Line (Outfile, Get_Line (Input));
      end loop;
      Close (Input);
   end Include_File;

   procedure Write_Line (Outfile : in File_Type;
                         Line    : in String) is
      Start : Natural := Line'First;
      Pos   : Natural;
   begin
      while Start <= Line'Last loop
         Pos := Ada.Strings.Fixed.Index (Line, "${", Start);
         if Pos = 0 then
            Text_IO.Put_Line (Outfile, Line (Start .. Line'Last));
            exit;
         elsif Line (Pos .. Pos + 7) = "${YYLEX}" then
            declare
               Name : constant String := Misc.Get_YYLex_Name;
            begin
               Text_IO.Put (Outfile, Line (Start .. Pos - 1));
               if Name'Length > 0 then
                  Text_IO.Put (Outfile, Name);
               else
                  Text_IO.Put (Outfile, "YYLex");
               end if;
               Start := Pos + 8;

            end;

         elsif Line (Pos .. Pos + 6) = "${NAME}" then
            Text_IO.Put (Outfile, Line (Start .. Pos - 1));
            Text_IO.Put (Outfile, Misc.Package_Name);
            Start := Pos + 7;

         elsif Line (Pos .. Pos + 7) = "${YYVAR}" then
            Text_IO.Put (Outfile, Line (Start .. Pos - 1));
            Text_IO.Put (Outfile, Misc.Get_YYVar_Name);
            Start := Pos + 8;

         elsif Line (Pos .. Pos + 11) = "${YYBUFSIZE}" then
            declare
               Bufsize : constant String := Natural'Image (Misc_Defs.YYBuf_Size);
            begin
               Text_IO.Put (Outfile, Line (Start .. Pos - 1));
               Text_IO.Put (Outfile, Bufsize (Bufsize'First + 1 .. Bufsize'Last));
               Start := Pos + 12;
            end;

         elsif Line (Pos .. Pos + 14) = "${YYLINENOTYPE}" then
            Text_IO.Put (Outfile, Line (Start .. Pos - 1));
            Text_IO.Put (Outfile, Misc.Get_YYLineno_Type_Name);
            Start := Pos + 15;

         else
            Text_IO.Put_Line (Outfile, Line (Start .. Line'Last));
            exit;
         end if;
         if Start > Line'Last then
            Text_IO.New_Line (Outfile);
         end if;
      end loop;
   end Write_Line;

   procedure Write_Indented (Outfile : in File_Type; Line : in String) is
      Start : constant Natural := Ada.Strings.Fixed.Index (Line, "(") + 1;
      Pos   : Natural := Line'First;
      Sep   : Natural;
   begin
      while Pos <= Line'Last loop
         Sep := Ada.Strings.Fixed.Index (Line, ";", Pos);
         if Sep > 0 then
            Text_IO.Put_Line (Outfile, Line (Pos .. Sep));
            Pos := Sep + 1;
            Text_IO.Set_Col (Outfile, Ada.Text_IO.Positive_Count (Start - Line'First));
         else
            Text_IO.Put_Line (Outfile, Line (Pos .. Line'Last));
            return;
         end if;
      end loop;
   end Write_Indented;

   procedure Template_Writer (Outfile  : in File_Type) is

      type Section_Type is (S_COMMON,
                            S_IF_DEBUG,
                            S_IF_OUTPUT,
                            S_IF_INPUT,
                            S_IF_ERROR,
                            S_IF_PRIVATE,
                            S_IF_ECHO,
                            S_IF_INTERACTIVE,
                            S_IF_YYLINENO,
                            S_IF_YYWRAP,
                            S_IF_YYWRAP_CODE,
                            S_IF_YYACTION,
                            S_IF_YYTYPE,
                            S_IF_YYDFA,
                            S_IF_REENTRANT,
                            S_IF_MINIMALIST_WITH,
                            S_IF_UNPUT);
      type Stack_Location is new Natural range 0 .. 10;
      type Stack_Condition is record
         Section  : Section_Type;
         Invert   : Boolean;
         Visible  : Boolean;
      end record;
      type Session_Stack is array (Stack_Location range 1 .. 10) of Stack_Condition;

      If_Stack   : Session_Stack;
      If_Pos     : Stack_Location := 0;
      Current    : Section_Type := S_COMMON;
      Is_Visible : Boolean := True;
      Parent_Visible : Boolean := True;
      Invert     : Boolean := False;
      Continue   : Boolean := True;

      procedure Push_Condition (Kind : Section_Type) is
      begin
         if If_Pos = Stack_Location'Last then
            raise Program_Error with "Template uses too many nested %if conditions";
         end if;
         If_Pos := If_Pos + 1;
         If_Stack (If_Pos) := (Current, Invert, Is_Visible);
         Current := Kind;
         Invert := False;
         Parent_Visible := Is_Visible;
      end Push_Condition;

      procedure Pop_Condition is
      begin
         if If_Pos = 0 then
            raise Program_Error with "Template contains an unmatched %end";
         end if;
         Current := If_Stack (If_Pos).Section;
         Invert := If_Stack (If_Pos).Invert;
         Parent_Visible := If_Stack (If_Pos).Visible;
         If_Pos := If_Pos - 1;
      end Pop_Condition;

   begin
      while Continue and then Has_Line loop
         declare
            Line : constant String := Get_Line;
         begin
            if Line'Length = 0 then
               if Is_Visible and Parent_Visible then
                  Text_IO.New_Line (Outfile);
               end if;
            elsif Line (Line'First) = '%' then
               if Line = "%if output" then
                  Push_Condition (S_IF_OUTPUT);
               elsif Line = "%if input" then
                  Push_Condition (S_IF_INPUT);
               elsif Line = "%if yylineno" then
                  Push_Condition (S_IF_YYLINENO);
               elsif Line = "%if unput" then
                  Push_Condition (S_IF_UNPUT);
               elsif Line = "%if debug" then
                  Push_Condition (S_IF_DEBUG);
               elsif Line = "%if error" then
                  Push_Condition (S_IF_ERROR);
               elsif Line = "%if private" then
                  Push_Condition (S_IF_PRIVATE);
               elsif Line = "%if interactive" then
                  Push_Condition (S_IF_INTERACTIVE);
               elsif Line = "%if yywrap" then
                  Push_Condition (S_IF_YYWRAP);
               elsif Line = "%if yywrapcode" then
                  Push_Condition (S_IF_YYWRAP_CODE);
               elsif Line = "%if yyaction" then
                  Push_Condition (S_IF_YYACTION);
               elsif Line = "%if yytype" then
                  Push_Condition (S_IF_YYTYPE);
               elsif Line = "%if yydfa" then
                  Push_Condition (S_IF_YYDFA);
               elsif Line = "%if echo" then
                  Push_Condition (S_IF_ECHO);
               elsif Line = "%if reentrant" then
                  Push_Condition (S_IF_REENTRANT);
               elsif Line = "%if minimalist" then
                  Push_Condition (S_IF_MINIMALIST_WITH);
               elsif Line = "%end" then
                  Pop_Condition;
               elsif Line = "%else" then
                  Invert := True;
               elsif Line = "%yydecl" then
                  if Is_Visible and Parent_Visible then
                     --  Special instruction to emil the function declaration
                     declare
                        Decl : constant String := Misc.Get_YYLex_Declaration;
                        Var  : constant String := Misc.Get_YYVar_Name;
                     begin
                        if Decl'Length > 0 then
                           Write_Indented (Outfile, Decl);
                        elsif not Reentrant then
                           Text_IO.Put_Line (Outfile, "   function YYLex return Token is");
                        else
                           Text_IO.Put (Outfile, "   function YYLex (");
                           Text_IO.Put (Outfile, Var);
                           Text_IO.Put_Line (Outfile, " : in out context_Type) is");
                        end if;
                     end;
                  end if;
               elsif Line = "%yytype" then
                  if Is_Visible and Parent_Visible then
                     Include_File (Outfile, YYTYPE_CODE_FILENAME);
                  end if;
               elsif Line = "%yydfa" then
                  if Is_Visible and Parent_Visible then
                     Include_File (Outfile, YYDFA_CODE_FILENAME);
                  end if;
               elsif Line = "%yyaction" then
                  if Is_Visible and Parent_Visible then
                     Include_File (Outfile, YYACTION_CODE_FILENAME);
                  end if;
               elsif Line = "%yywrap" then
                  if Is_Visible and Parent_Visible then
                     Include_File (Outfile, YYWRAP_CODE_FILENAME);
                  end if;
               elsif Line = "%yyinit" then
                  if Is_Visible and Parent_Visible then
                     Include_File (Outfile, YYINIT_CODE_FILENAME);
                  end if;
               elsif Line'Length > 3 and then Line (Line'First + 1) = '%' then
                  Continue := False;
                  return;
               else
                  --  Very crude error report when the template % line is invalid.
                  --  This could happen only during development when templates
                  --  are modified.
                  raise Program_Error with "Invalid template '%' rule: " & Line;
               end if;
               Is_Visible := (Current = S_COMMON)
                 or else (Current = S_IF_YYLINENO and then Use_YYLineno)
                 or else (Current = S_IF_DEBUG and then Ddebug)
                 or else (Current = S_IF_INTERACTIVE and then Interactive)
                 or else (Current = S_IF_PRIVATE and then Private_Package)
                 or else (Current = S_IF_UNPUT and then not No_Unput)
                 or else (Current = S_IF_OUTPUT and then not No_Output)
                 or else (Current = S_IF_INPUT and then not No_Input)
                 or else (Current = S_IF_YYWRAP and then not No_YYWrap)
                 or else (Current = S_IF_YYWRAP_CODE and then Has_Code (YYWRAP_CODE))
                 or else (Current = S_IF_YYACTION and then Has_Code (YYACTION_CODE))
                 or else (Current = S_IF_YYTYPE and then Has_Code (YYTYPE_CODE))
                 or else (Current = S_IF_YYDFA and then Has_Code (YYDFA_CODE))
                 or else (Current = S_IF_REENTRANT and then Reentrant)
                 or else (Current = S_IF_ECHO and then not Spprdflt)
                 or else (Current = S_IF_MINIMALIST_WITH and then Minimalist_With)
                 or else (Current = S_IF_ERROR and then Ayacc_Extension_Flag);
               if Invert then
                  Is_Visible := not Is_Visible;
               end if;

            elsif Is_Visible and Parent_Visible then
               Write_Line (Outfile, Line);
            end if;
         end;
      end loop;
   end Template_Writer;

   procedure Write_Template (Outfile  : in File_Type;
                             Lines    : in Content_Array;
                             Position : in out Positive) is
      function Has_Line return Boolean is
      begin
         return Position <= Lines'Last;
      end Has_Line;

      function Get_Line return String is
      begin
         Position := Position + 1;
         return Lines (Position - 1).all;
      end Get_Line;

      procedure Write is new Template_Writer (Has_Line, Get_Line);

   begin
      Write (Outfile);
    end Write_Template;

   procedure Generate_Dfa_File is
      Dfa_Out_File : File_Type;
      Dfa_Line     : Positive := 1;
   begin
      External_File_Manager.Get_Dfa_File (Dfa_Out_File, True);
      Write_Template (Dfa_Out_File,
                      (if Reentrant then Templates.spec_reentrant_dfa else Templates.spec_dfa),
                      Dfa_Line);
      Text_Io.Close (Dfa_Out_File);

      External_File_Manager.Get_Dfa_File (Dfa_Out_File, False);
      Text_Io.New_Line (Dfa_Out_File);

      Dfa_Line := 1;
      Write_Template (Dfa_Out_File,
                      (if Reentrant then Templates.body_reentrant_dfa else Templates.body_dfa),
                      Dfa_Line);
   end Generate_Dfa_File;

   procedure Generate_Io_File is
      Io_Out_File : File_Type;
      IO_Line     : Positive := 1;
   begin
      External_File_Manager.Get_Io_File (Io_Out_File, True);

      Write_Template (Io_Out_File,
                      (if Reentrant then Templates.spec_reentrant_io else Templates.spec_io),
                      IO_Line);
      Text_Io.Close (Io_Out_File);

      External_File_Manager.Get_Io_File (Io_Out_File, False);
      IO_Line := 1;
      Write_Template (Io_Out_File,
                      (if Reentrant then Templates.body_reentrant_io else Templates.body_io),
                      IO_Line);
   end Generate_Io_File;

   procedure Cleanup is
   begin
      if Ada.Directories.Exists (YYTYPE_CODE_FILENAME) then
         Ada.Directories.Delete_File (YYTYPE_CODE_FILENAME);
      end if;
      if Ada.Directories.Exists (YYDFA_CODE_FILENAME) then
         Ada.Directories.Delete_File (YYDFA_CODE_FILENAME);
      end if;
      if Ada.Directories.Exists (YYINIT_CODE_FILENAME) then
         Ada.Directories.Delete_File (YYINIT_CODE_FILENAME);
      end if;
      if Ada.Directories.Exists (YYACTION_CODE_FILENAME) then
         Ada.Directories.Delete_File (YYACTION_CODE_FILENAME);
      end if;
      if Ada.Directories.Exists (YYWRAP_CODE_FILENAME) then
         Ada.Directories.Delete_File (YYWRAP_CODE_FILENAME);
      end if;
   end Cleanup;

end Template_Manager;