PreviousUpNext

15.4.143  src/app/yacc/src/header-g.pkg

#  Mythryl-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 

# Compiled by:
#     src/app/yacc/src/mythryl-yacc.lib

###              "If you can talk, you can sing.
###               If you can walk, you can dance."
###
###                           -- African proverb 



stipulate
    package fil =  file__premicrothread;                                # file__premicrothread  is from   src/lib/std/src/posix/file--premicrothread.pkg
herein

    generic package header_g () : (weak) Header {                       # Header                is from   src/app/yacc/src/header.api
        #           ========
        #
        debug = TRUE;

        Source_Position = Int;

        lineno = REF 0;
        text   = REF (NIL: List( String ));

        Input_Source = { name:          String,
                         err_stream:     fil::Output_Stream,
                         in_stream:      fil::Input_Stream,
                         error_occurred: Ref( Bool )
                       };

        fun make_source (   s:     String,
                            i:     fil::Input_Stream,
                            errs:  fil::Output_Stream
                        )
            =
            {   name      =>   s,
                err_stream =>   errs,
                in_stream  =>   i,

                error_occurred =>   REF FALSE
            };

        fun error_occurred (s:  Input_Source) ()
            =
            *s.error_occurred;

        fun pr (out:  fil::Output_Stream)
               (s:  String)
            =
            fil::write (out, s);

        fun error ({ name, err_stream, error_occurred, ... } : Input_Source)
            =
            {   pr = pr err_stream;
                #
                fn  l:  Source_Position
                    => fn msg:  String
                    =>
                    {   pr name;
                        pr ", line ";
                        pr (int::to_string l);
                        pr ": Error: ";
                        pr msg;
                        pr "\n";
                        error_occurred := TRUE;
                    }; end; end;
            };

        fun warn ({ name, err_stream, error_occurred, ... } : Input_Source)
            =
            {   pr = pr err_stream;
                #
                fn  l:  Source_Position
                    => fn msg:  String
                           =>
                           {   pr name;
                               pr ", line ";
                               pr (int::to_string l);
                               pr ": Warning: ";
                               pr msg;
                               pr "\n";
                           };
                       end;
                end;
            };

         Precedence = LEFT | RIGHT | NONASSOC;

         Symbol = SYMBOL  (String, Source_Position);

        fun symbol_name (SYMBOL (s, _)) =   s;
        fun symbol_pos   (SYMBOL (_, p)) =   p;

        fun symbol_make sp =   SYMBOL sp;

         Type = String;

        type_name =   fn i = i;
        type_make =   fn i = i;

         Control = NODEFAULT
                 | VERBOSE
                 | PARSER_NAME  Symbol
                 | GENERIC  String 
                 | START_SYM  Symbol
                 | NSHIFT   List( Symbol )
                 | POS  String
                 | PURE
                 | PARSE_ARG  (String, String)
                 | TOKEN_API_INFO  String
                 ;

         Decl_Data
            =
            DECL  {
                eop:     List( Symbol ),
                keyword: List( Symbol ),
                nonterm: Null_Or( List ((Symbol,  Null_Or( Type )) ) ),
                prec:    List ((Precedence, ( List( Symbol ) )) ),
                change:  List( (List( Symbol ), List( Symbol )) ),
                term:    Null_Or( List( (Symbol, Null_Or( Type )) ) ),
                control: List( Control ),
                value:   List ((Symbol, String))
            };

         Rhs_Data                               # "Rhs" == "Right-hand side" (of grammar rule)
            =
            List {
                rhs:   List( Symbol ),
                code:  String,
                prec:  Null_Or( Symbol )        # "prec" is "precedence"
            }; 

         Rule
            =
            RULE  {
                lhs:   Symbol,
                rhs:   List( Symbol ),
                code:  String,
                prec:  Null_Or( Symbol )
            };

         Parse_Result
            =
            (String, Decl_Data, List( Rule ));

        fun get_result p
            =
            p;

        fun join_decls (  DECL { eop=>e,  control=>c,  keyword=>k,  nonterm=>n,  prec,        change=>su,  term=>t,  value=>v }:   Decl_Data,
                          DECL { eop=>e', control=>c', keyword=>k', nonterm=>n', prec=>prec', change=>su', term=>t', value=>v'}:   Decl_Data,
                          input_source,
                          pos
                       )
            =
            {   fun ignore s
                    =
                    warn input_source pos ("ignoring duplicate " + s + " declaration");

                fun join (e, NULL, NULL) =>   NULL;
                    join (e, NULL, a   ) =>   a;
                    join (e, a,    NULL) =>   a;
                    join (e, a,    b   ) =>   { ignore e;   a; };
                end;

                fun merge_control (NIL, a)
                        =>
                        [a];

                    merge_control (l as h ! t, a)
                        =>
                        case (h, a)

                             (PARSER_NAME   _,  PARSER_NAME   n1) =>   { ignore "%name";           l; };
                             (GENERIC _,  GENERIC  _) =>   { ignore "%header";         l; };
                             (PARSE_ARG _,      PARSE_ARG      _) =>   { ignore "%arg";            l; };
                             (START_SYM _,      START_SYM      s) =>   { ignore "%start";          l; };
                             (POS _,            POS            _) =>   { ignore "%pos";            l; };
                             (TOKEN_API_INFO _, TOKEN_API_INFO _) =>   { ignore "%token_api_info"; l; };
                             (NSHIFT a,         NSHIFT         b) =>   ( NSHIFT (a@b) ! t );
                             _                                    =>   h ! merge_control (t, a);
                        esac;
                end;

                fun loop (NIL,   r) =>   r;
                    loop (h ! t, r) =>   loop (t, merge_control (r, h));
                end;

                DECL {
                    eop     => e @ e',
                    control => loop (c', c),
                    keyword => k' @ k,
                    nonterm => join ("%nonterm", n, n'),
                    prec    => prec @ prec',
                    change  => su @ su',
                    term    => join ("%term", t, t'),
                    value   => v @ v'
                }: Decl_Data;
        };
    };
end;

package header
    =
    header_g ();
      


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext