# 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
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: file::Output_Stream,
in_stream: file::Input_Stream,
error_occurred: Ref( Bool )
};
fun make_source ( s: String,
i: file::Input_Stream,
errs: file::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: file::Output_Stream)
(s: String)
=
file::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;
};
};
package header
=
header_g ();