DataMuseum.dk

top - download

    Length: 20277 (0x4f35)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with File_String, Misc_Defs, Text_Io, External_File_Manager, Misc, Tstring;
use File_String, Misc_Defs, Text_Io;
package body Template_Manager is

    type File_Array is array (Positive range <>) of Vstring;

    Dfa_Template : File_Array (1 .. 66) :=
       (
        --DFA TEMPLATE START
        Vstr ("yytext_ptr : integer; -- points to start of yytext in buffer"),
        Vstr (""),
        Vstr
           ("-- yy_ch_buf has to be 2 characters longer than YY_BUF_SIZE because we need"),
        Vstr
           ("-- to put in 2 end-of-buffer characters (this is explained where it is"),
        Vstr ("-- done) at the end of yy_ch_buf"),
        Vstr ("YY_READ_BUF_SIZE : constant integer :=  8192;"),
        Vstr
           ("YY_BUF_SIZE : constant integer := YY_READ_BUF_SIZE * 2; -- size of input buffer"),
        Vstr
           ("type unbounded_character_array is array(integer range <>) of character;"),
        Vstr
           ("subtype ch_buf_type is unbounded_character_array(0..YY_BUF_SIZE + 1);"),
        Vstr ("yy_ch_buf : ch_buf_type;"),
        Vstr ("yy_cp, yy_bp : integer;"), Vstr (""),
        Vstr ("-- yy_hold_char holds the character lost when yytext is formed"),
        Vstr ("yy_hold_char : character;"),
        Vstr
           ("yy_c_buf_p : integer;   -- points to current character in buffer"),
        Vstr (""), Vstr ("function YYText return string;"),
        Vstr ("function YYLength return integer;"),
        Vstr ("procedure YY_DO_BEFORE_ACTION;"),
        Vstr ("--These variables are needed between calls to YYLex."),
        Vstr ("yy_init : boolean := true; -- do we need to initialize YYLex?"),
        Vstr ("yy_start : integer := 0; -- current start state number"),
        Vstr ("subtype yy_state_type is integer;"),
        Vstr ("yy_last_accepting_state : yy_state_type;"),
        Vstr ("yy_last_accepting_cpos : integer;"), Vstr ("%%"),
        Vstr ("function YYText return string is"),
        Vstr ("    i : integer;"), Vstr ("    str_loc : integer := 1;"),
        Vstr ("    buffer : string(1..1024);"),
        Vstr ("    EMPTY_STRING : constant string := """";"), Vstr ("begin"),
        Vstr ("    -- find end of buffer"), Vstr ("    i := yytext_ptr;"),
        Vstr ("    while ( yy_ch_buf(i) /= ASCII.NUL ) loop"),
        Vstr ("    buffer(str_loc ) := yy_ch_buf(i);"),
        Vstr ("        i := i + 1;"),
        Vstr ("    str_loc := str_loc + 1;"), Vstr ("    end loop;"),
        Vstr ("--    return yy_ch_buf(yytext_ptr.. i - 1);"), Vstr (""),
        Vstr ("    if (str_loc < 2) then"),
        Vstr ("        return EMPTY_STRING;"), Vstr ("    else"),
        Vstr ("      return buffer(1..str_loc-1);"), Vstr ("    end if;"),
        Vstr (""), Vstr ("end;"), Vstr (""),
        Vstr ("-- returns the length of the matched text"),
        Vstr ("function YYLength return integer is"), Vstr ("begin"),
        Vstr ("    return yy_cp - yy_bp;"),
        Vstr ("end YYLength;"), Vstr (""),
        Vstr
           ("-- done after the current pattern has been matched and before the"),
        Vstr ("-- corresponding action - sets up yytext"),
        Vstr (""), Vstr ("procedure YY_DO_BEFORE_ACTION is"),
        Vstr ("begin"), Vstr ("    yytext_ptr := yy_bp;"),
        Vstr ("    yy_hold_char := yy_ch_buf(yy_cp);"),
        Vstr ("    yy_ch_buf(yy_cp) := ASCII.NUL;"),
        Vstr ("    yy_c_buf_p := yy_cp;"),
        Vstr ("end YY_DO_BEFORE_ACTION;"), Vstr ("")
--DFA TEMPLATE END
        );

    Dfa_Current_Line : Integer := 1;

    Io_Template : File_Array (1 .. 264) :=
       (
        --IO TEMPLATE START
        Vstr ("with text_io; use text_io;"), Vstr (""),
        Vstr ("%%"), Vstr ("NULL_IN_INPUT : exception;"),
        Vstr ("AFLEX_INTERNAL_ERROR : exception;"),
        Vstr ("UNEXPECTED_LAST_MATCH : exception;"),
        Vstr ("PUSHBACK_OVERFLOW : exception;"),
        Vstr ("AFLEX_SCANNER_JAMMED : exception;"),
        Vstr ("type eob_action_type is ( EOB_ACT_RESTART_SCAN,"),
        Vstr ("                          EOB_ACT_END_OF_FILE,"),
        Vstr ("                          EOB_ACT_LAST_MATCH );"),
        Vstr ("YY_END_OF_BUFFER_CHAR :  constant character:=  ASCII.NUL;"),
        Vstr
           ("yy_n_chars : integer;       -- number of characters read into yy_ch_buf"),
        Vstr (""),
        Vstr ("-- true when we've seen an EOF for the current input file"),
        Vstr ("yy_eof_has_been_seen : boolean;"),
        Vstr (""),
        Vstr
           ("procedure YY_INPUT(buf: out unbounded_character_array; result: out integer; max_size: in integer);"),
        Vstr ("function yy_get_next_buffer return eob_action_type;"),
        Vstr ("procedure yyunput( c : character; yy_bp: in out integer );"),
        Vstr ("procedure unput(c : character);"),
        Vstr ("function input return character;"),
        Vstr ("procedure output(c : character);"),
        Vstr ("function yywrap return boolean;"),
        Vstr ("procedure Open_Input(fname : in String);"),
        Vstr ("procedure Close_Input;"),
        Vstr ("procedure Create_Output(fname : in String := """");"),
        Vstr ("procedure Close_Output;"), Vstr ("%%"),
        Vstr
           ("-- gets input and stuffs it into 'buf'.  number of characters read, or YY_NULL,"),
        Vstr ("-- is returned in 'result'."), Vstr (""),
        Vstr
           ("procedure YY_INPUT(buf: out unbounded_character_array; result: out integer; max_size: in integer) is"),
        Vstr ("    c : character;"), Vstr ("    i : integer := 1;"),
        Vstr ("    loc : integer := buf'first;"), Vstr ("begin"),
        Vstr ("    while ( i <= max_size ) loop"),
        Vstr
           ("    if (end_of_line) then -- Ada ate our newline, put it back on the end."),
        Vstr ("            buf(loc) := ASCII.LF;"),
        Vstr ("            skip_line(1);"), Vstr ("%%"), Vstr ("        else"),
        Vstr ("            get(buf(loc));"), Vstr ("    end if; "),
        Vstr ("    "), Vstr ("        loc := loc + 1;"),
        Vstr ("    i := i + 1;"), Vstr ("    end loop;"), Vstr ("    "),
        Vstr ("    result := i - 1; "), Vstr ("    exception"),
        Vstr ("        when END_ERROR => result := i - 1;"),
        Vstr ("    -- when we hit EOF we need to set yy_eof_has_been_seen"),
        Vstr ("    yy_eof_has_been_seen := true;"), Vstr ("end YY_INPUT;"),
        Vstr (""), Vstr ("-- yy_get_next_buffer - try to read in new buffer"),
        Vstr ("--"), Vstr ("-- returns a code representing an action"),
        Vstr ("--     EOB_ACT_LAST_MATCH - "),
        Vstr ("--     EOB_ACT_RESTART_SCAN - restart the scanner"),
        Vstr ("--     EOB_ACT_END_OF_FILE - end of file"), Vstr (""),
        Vstr ("function yy_get_next_buffer return eob_action_type is"),
        Vstr ("    dest : integer := 0;"),
        Vstr
           ("    source : integer := yytext_ptr - 1; -- copy prev. char, too"),
        Vstr ("    number_to_move : integer;"),
        Vstr ("    ret_val : eob_action_type;"),
        Vstr ("    num_to_read : integer;"), Vstr ("begin    "),
        Vstr ("    if ( yy_c_buf_p > yy_n_chars + 1 ) then"),
        Vstr ("        raise NULL_IN_INPUT;"), Vstr ("    end if;"), Vstr (""),
        Vstr ("    -- try to read more data"), Vstr (""),
        Vstr ("    -- first move last chars to start of buffer"),
        Vstr ("    number_to_move := yy_c_buf_p - yytext_ptr;"), Vstr (""),
        Vstr ("    for i in 0..number_to_move - 1 loop"),
        Vstr ("        yy_ch_buf(dest) := yy_ch_buf(source);"),
        Vstr ("    dest := dest + 1;"), Vstr ("    source := source + 1;"),
        Vstr ("    end loop;"), Vstr ("        "),
        Vstr ("    if ( yy_eof_has_been_seen ) then"),
        Vstr
           ("    -- don't do the read, it's not guaranteed to return an EOF,"),
        Vstr ("    -- just force an EOF"), Vstr (""),
        Vstr ("    yy_n_chars := 0;"), Vstr ("    else"),
        Vstr ("    num_to_read := YY_BUF_SIZE - number_to_move - 1;"),
        Vstr (""), Vstr ("    if ( num_to_read > YY_READ_BUF_SIZE ) then"),
        Vstr ("        num_to_read := YY_READ_BUF_SIZE;"),
        Vstr ("        end if;"), Vstr (""),
        Vstr ("    -- read in more data"),
        Vstr
           ("    YY_INPUT( yy_ch_buf(number_to_move..yy_ch_buf'last), yy_n_chars, num_to_read );"),
        Vstr ("    end if;"), Vstr ("    if ( yy_n_chars = 0 ) then"),
        Vstr ("    if ( number_to_move = 1 ) then"),
        Vstr ("        ret_val := EOB_ACT_END_OF_FILE;"), Vstr ("    else"),
        Vstr ("        ret_val := EOB_ACT_LAST_MATCH;"),
        Vstr ("        end if;"), Vstr (""),
        Vstr ("    yy_eof_has_been_seen := true;"), Vstr ("    else"),
        Vstr ("    ret_val := EOB_ACT_RESTART_SCAN;"),
        Vstr ("    end if;"), Vstr ("    "),
        Vstr ("    yy_n_chars := yy_n_chars + number_to_move;"),
        Vstr ("    yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;"),
        Vstr ("    yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;"),
        Vstr (""), Vstr ("    -- yytext begins at the second character in"),
        Vstr ("    -- yy_ch_buf; the first character is the one which"),
        Vstr ("    -- preceded it before reading in the latest buffer;"),
        Vstr ("    -- it needs to be kept around in case it's a"),
        Vstr ("    -- newline, so yy_get_previous_state() will have"),
        Vstr ("    -- with '^' rules active"),
        Vstr (""), Vstr ("    yytext_ptr := 1;"),
        Vstr (""), Vstr ("    return ret_val;"),
        Vstr ("end yy_get_next_buffer;"), Vstr (""),
        Vstr ("procedure yyunput( c : character; yy_bp: in out integer ) is"),
        Vstr ("    number_to_move : integer;"),
        Vstr ("    dest : integer;"), Vstr ("    source : integer;"),
        Vstr ("    tmp_yy_cp : integer;"), Vstr ("begin"),
        Vstr ("    tmp_yy_cp := yy_c_buf_p;"),
        Vstr
           ("    yy_ch_buf(tmp_yy_cp) := yy_hold_char; -- undo effects of setting up yytext"),
        Vstr (""), Vstr ("    if ( tmp_yy_cp < 2 ) then"),
        Vstr ("    -- need to shift things up to make room"),
        Vstr ("    number_to_move := yy_n_chars + 2; -- +2 for EOB chars"),
        Vstr ("    dest := YY_BUF_SIZE + 2;"),
        Vstr ("    source := number_to_move;"), Vstr (""),
        Vstr ("    while ( source > 0 ) loop"),
        Vstr ("        dest := dest - 1;"),
        Vstr ("        source := source - 1;"),
        Vstr ("            yy_ch_buf(dest) := yy_ch_buf(source);"),
        Vstr ("    end loop;"), Vstr (""),
        Vstr ("    tmp_yy_cp := tmp_yy_cp + dest - source;"),
        Vstr ("    yy_bp := yy_bp + dest - source;"),
        Vstr ("    yy_n_chars := YY_BUF_SIZE;"), Vstr (""),
        Vstr ("    if ( tmp_yy_cp < 2 ) then"),
        Vstr ("        raise PUSHBACK_OVERFLOW;"),
        Vstr ("    end if;"), Vstr ("    end if;"), Vstr (""),
        Vstr
           ("    if ( tmp_yy_cp > yy_bp and then yy_ch_buf(tmp_yy_cp-1) = ASCII.LF ) then"),
        Vstr ("    yy_ch_buf(tmp_yy_cp-2) := ASCII.LF;"), Vstr ("    end if;"),
        Vstr (""), Vstr ("    tmp_yy_cp := tmp_yy_cp - 1;"),
        Vstr ("    yy_ch_buf(tmp_yy_cp) := c;"), Vstr (""),
        Vstr ("--  Note:  this code is the text of YY_DO_BEFORE_ACTION, only"),
        Vstr ("--         here we get different yy_cp and yy_bp's"),
        Vstr ("    yytext_ptr := yy_bp;"),
        Vstr ("    yy_hold_char := yy_ch_buf(tmp_yy_cp);"),
        Vstr ("    yy_ch_buf(tmp_yy_cp) := ASCII.NUL;"),
        Vstr ("    yy_c_buf_p := tmp_yy_cp;"), Vstr ("end yyunput;"), Vstr (""),
        Vstr ("procedure unput(c : character) is"), Vstr ("begin"),
        Vstr ("     yyunput( c, yy_bp );"), Vstr ("end unput;"), Vstr (""),
        Vstr ("function input return character is"),
        Vstr ("    c : character;"),
        Vstr ("    yy_cp : integer := yy_c_buf_p;"), Vstr ("begin"),
        Vstr ("    yy_ch_buf(yy_cp) := yy_hold_char;"), Vstr (""),
        Vstr ("    if ( yy_ch_buf(yy_c_buf_p) = YY_END_OF_BUFFER_CHAR ) then"),
        Vstr ("    -- need more input"),
        Vstr ("    yytext_ptr := yy_c_buf_p;"),
        Vstr ("    yy_c_buf_p := yy_c_buf_p + 1;"), Vstr (""),
        Vstr ("    case yy_get_next_buffer is"),
        Vstr
           ("        -- this code, unfortunately, is somewhat redundant with"),
        Vstr ("        -- that above"), Vstr (""),
        Vstr ("        when EOB_ACT_END_OF_FILE =>"),
        Vstr ("        if ( yywrap ) then"),
        Vstr ("            yy_c_buf_p := yytext_ptr;"),
        Vstr ("            return ASCII.NUL;"),
        Vstr ("        end if;"), Vstr (""),
        Vstr ("        yy_ch_buf(0) := ASCII.LF;"),
        Vstr ("        yy_n_chars := 1;"),
        Vstr ("        yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;"),
        Vstr ("        yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;"),
        Vstr ("        yy_eof_has_been_seen := false;"),
        Vstr ("        yy_c_buf_p := 1;"),
        Vstr ("        yytext_ptr := yy_c_buf_p;"),
        Vstr ("        yy_hold_char := yy_ch_buf(yy_c_buf_p);"), Vstr (""),
        Vstr ("        return ( input );"),
        Vstr ("        when EOB_ACT_RESTART_SCAN =>"),
        Vstr ("        yy_c_buf_p := yytext_ptr;"), Vstr (""),
        Vstr ("        when EOB_ACT_LAST_MATCH =>"),
        Vstr ("        raise UNEXPECTED_LAST_MATCH;"),
        Vstr ("        when others => null;"), Vstr ("        end case;"),
        Vstr ("    end if;"), Vstr (""),
        Vstr ("    c := yy_ch_buf(yy_c_buf_p);"),
        Vstr ("    yy_c_buf_p := yy_c_buf_p + 1;"),
        Vstr ("    yy_hold_char := yy_ch_buf(yy_c_buf_p);"),
        Vstr (""), Vstr ("    return c;"),
        Vstr ("end input;"), Vstr (""),
        Vstr ("procedure output(c : character) is"), Vstr ("begin"),
        Vstr ("    text_io.put(c);"),
        Vstr ("end output;"), Vstr (""),
        Vstr ("-- default yywrap function - always treat EOF as an EOF"),
        Vstr ("function yywrap return boolean is"),
        Vstr ("begin"), Vstr ("    return true;"),
        Vstr ("end yywrap;"), Vstr (""),
        Vstr ("procedure Open_Input(fname : in String) is"),
        Vstr ("    f : file_type;"), Vstr ("begin"),
        Vstr ("    yy_init := true;"),
        Vstr ("    open(f, in_file, fname);"), Vstr ("    set_input(f);"),
        Vstr ("end Open_Input;"), Vstr (""),
        Vstr ("procedure Create_Output(fname : in String := """") is"),
        Vstr ("    f : file_type;"), Vstr ("begin"),
        Vstr ("    if (fname /= """") then"),
        Vstr ("        create(f, out_file, fname);"),
        Vstr ("        set_output(f);"), Vstr ("    end if;"),
        Vstr ("end Create_Output;"), Vstr (""),
        Vstr ("procedure Close_Input is"),
        Vstr ("begin"), Vstr ("    null;"),
        Vstr ("end Close_Input;"), Vstr (""),
        Vstr ("procedure Close_Output is"),
        Vstr ("begin"), Vstr ("    null;"),
        Vstr ("end Close_Output;"), Vstr ("")
--IO TEMPLATE END
        );

    Io_Current_Line : Integer := 1;

    procedure Template_Out (Outfile : in File_Type;
                            Current_Template : in File_Array;
                            Line_Number : in out Integer) is
        Buf : Vstring;
    begin
        while (not (Line_Number > Current_Template'Last)) loop
            Buf := Current_Template (Line_Number);
            Line_Number := Line_Number + 1;
            if ((File_String.Len (Buf) >= 2) and then
                ((Char (Buf, 1) = '%') and (Char (Buf, 2) = '%'))) then
                exit;
            else
                File_String.Put_Line (Outfile, Buf);
            end if;
        end loop;
    end Template_Out;

    procedure Generate_Dfa_File is
        Dfa_Out_File : File_Type;
    begin
        External_File_Manager.Get_Dfa_File (Dfa_Out_File);
        Text_Io.Put_Line
           (Dfa_Out_File, "package " & Tstring.Str (Misc.Basename) &
                             "_dfa" & " is");

        if (Ddebug) then

            -- make a scanner that output acceptance information
            Text_Io.Put_Line (Dfa_Out_File, "aflex_debug : boolean := true;");
        else
            Text_Io.Put_Line (Dfa_Out_File, "aflex_debug : boolean := false;");
        end if;
        Template_Out (Dfa_Out_File, Dfa_Template, Dfa_Current_Line);
        Text_Io.Put_Line (Dfa_Out_File,
                          "end " & Tstring.Str (Misc.Basename) & "_dfa;");
        Text_Io.New_Line (Dfa_Out_File);
        Text_Io.Put (Dfa_Out_File,
                     "with " & Tstring.Str (Misc.Basename) & "_dfa" & "; ");
        Text_Io.Put_Line (Dfa_Out_File,
                          "use " & Tstring.Str (Misc.Basename) & "_dfa" & "; ");
        Text_Io.Put_Line
           (Dfa_Out_File, "package body " & Tstring.Str (Misc.Basename) &
                             "_dfa" & " is");
        Template_Out (Dfa_Out_File, Dfa_Template, Dfa_Current_Line);
        Text_Io.Put_Line (Dfa_Out_File,
                          "end " & Tstring.Str (Misc.Basename) & "_dfa;");
    end Generate_Dfa_File;

    procedure Generate_Io_File is
        Io_Out_File : File_Type;
    begin
        External_File_Manager.Get_Io_File (Io_Out_File);
        Text_Io.Put (Io_Out_File,
                     "with " & Tstring.Str (Misc.Basename) & "_dfa" & "; ");
        Text_Io.Put_Line (Io_Out_File,
                          "use " & Tstring.Str (Misc.Basename) & "_dfa" & "; ");
        Template_Out (Io_Out_File, Io_Template, Io_Current_Line);
        Text_Io.Put_Line
           (Io_Out_File, "package " & Tstring.Str (Misc.Basename) &
                            "_io" & " is");
        Template_Out (Io_Out_File, Io_Template, Io_Current_Line);
        Text_Io.Put_Line (Io_Out_File,
                          "end " & Tstring.Str (Misc.Basename) & "_io;");
        Text_Io.New_Line (Io_Out_File);
        Text_Io.Put_Line
           (Io_Out_File, "package body " & Tstring.Str (Misc.Basename) &
                            "_io" & " is");
        Template_Out (Io_Out_File, Io_Template, Io_Current_Line);
        -- If we're generating a scanner for interactive mode we need to generate
        -- a YY_INPUT that stops at the end of each line
        if Interactive then
            Text_Io.Put_Line
               (Io_Out_File,
                "            i := i + 1; -- update counter, miss end of loop");
            Text_Io.Put_Line
               (Io_Out_File,
                "            exit; -- in interactive mode return at end of line.");
        end if;
        Template_Out (Io_Out_File, Io_Template, Io_Current_Line);  
        Text_Io.Put_Line (Io_Out_File,
                          "end " & Tstring.Str (Misc.Basename) & "_io;");
    end Generate_Io_File;

end Template_Manager;
-- 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: /co/ua/self/arcadia/aflex/ada/src/RCS/template_managerS.a,v 1.3 90/01/12 15:20:49 self Exp Locker: self $