## nada-parser-guts.pkg
## (C) 2001 Lucent Technologies, Bell Labs
# Compiled by:
#
src/lib/compiler/front/parser/parser.sublibstipulate
package cos = compile_statistics; # compile_statistics is from
src/lib/compiler/front/basics/stats/compile-statistics.pkg package err = error_message; # error_message is from
src/lib/compiler/front/basics/errormsg/error-message.pkg package fil = file__premicrothread; # file__premicrothread is from
src/lib/std/src/posix/file--premicrothread.pkg package lnd = line_number_db; # line_number_db is from
src/lib/compiler/front/basics/source/line-number-db.pkg package lrp = lr_parser; # lr_parser is from
src/app/yacc/lib/parser2.pkg package raw = raw_syntax; # raw_syntax is from
src/lib/compiler/front/parser/raw-syntax/raw-syntax.pkg package sci = sourcecode_info; # sourcecode_info is from
src/lib/compiler/front/basics/source/sourcecode-info.pkg package str = string; # string is from
src/lib/std/string.pkgherein
package nada_parser_guts
: (weak) Nada_Parser_Guts # Nada_Parser_Guts is from
src/lib/compiler/front/parser/main/nada-parser-guts.api {
package nada_lr_vals
=
nada_lr_vals_fun (
package token= lrp::token; # lr_parser is from
src/app/yacc/lib/parser2.pkg );
package lex
=
nada_lex_g (
package tokens = nada_lr_vals::tokens;
);
package relex
=
relex_g (
package parser_data = nada_lr_vals::parser_data;
package tokens = nada_lr_vals::tokens;
package lex = lex;
);
package mlp
=
make_complete_yacc_parser_with_custom_argument_g (
#
package parser_data = nada_lr_vals::parser_data;
package lex = relex;
package lr_parser = lr_parser;
);
increment_linecount_by
=
cos::increment_counterssum_by (cos::make_counterssum' "Source Lines");
package err= error_message;
Parse_Result = EOF # End of file reached
| ERROR
# Parsed successfully, but with syntactic or semantic errors
| ABORT
# Could not even parse to end of declaration
| PARSE raw::Declaration
;
dummy_eof = nada_lr_vals::tokens::eof (0, 0);
dummy_dot = nada_lr_vals::tokens::suffix_dot (0, 0);
fun prompt_read_parse_and_return_one_toplevel_nada_expression (
source as {
source_stream,
error_consumer,
is_interactive,
line_number_db,
saw_errors, ...
}
: sci::Sourcecode_Info
)
=
{ err = err::error source;
complain_match
=
err::match_error_string source;
fun parse_error (s, p1, p2)
=
err (p1, p2) err::ERROR s err::null_error_body;
lex_arg = { comment_nesting_depth => REF 0,
line_number_db,
charlist => REF (NIL: List( String )),
stringtype => REF FALSE,
stringstart => REF 0,
brack_stack => REF (NIL: List( Ref( Int ) )),
err
};
do_prompt = REF TRUE;
prompt = REF *nada_parser::primary_prompt;
fun inputc_source_stream _
=
fil::read (source_stream);
exception ABORT_LEX;
# Read one line of interactive input from user.
# (This function is called only when parsing
# interactively entered program text.)
fun get_line k
=
{ if *do_prompt
#
if *saw_errors raise exception ABORT_LEX; fi;
# XXX BUGGO FIXME Eventually we need a switch and conditionals to turn
# all this verbosity up/down, but for the moment (2007-03-14) I just want
# to get shebang scripts running, so I'm just switching this stuff off.
# That will make interactive mode pretty cryptic, of course...
# control_print::say
# ( if *lexArg.comment_nesting_depth > 0
# or
# *lexArg.charlist != NIL
# then
# *nada_parser::secondary_prompt
# else
# *prompt
# );
#
# control_print::flush();
do_prompt := FALSE;
fi;
{ s = inputc_source_stream k;
do_prompt := ( (str::get_byte_as_char (s, size s - 1) == '\n')
except
_ = FALSE
);
s;
};
};
lexer
=
lex::make_lexer
(if is_interactive get_line;
else inputc_source_stream;
fi
)
lex_arg;
lexer' = REF (lrp::stream::streamify lexer);
lookahead = if is_interactive 0;
else 30;
fi;
fun prompt_read_parse_and_return_one_toplevel_nada_expression ()
=
{ prompt := *nada_parser::primary_prompt;
my (next_token, rest)
=
lrp::stream::get *lexer';
start_position = lnd::last_change line_number_db;
fun lines_read ()
=
lnd::newline_count
line_number_db
( start_position,
lnd::last_change line_number_db
);
# if is_interactive
# then lnd::forgetOldPositions line_number_db
#
if (mlp::same_token (next_token, dummy_dot))
#
lexer' := rest;
prompt_read_parse_and_return_one_toplevel_nada_expression ();
else
if (mlp::same_token (next_token, dummy_eof))
#
EOF;
else
prompt := *nada_parser::secondary_prompt;
my (result, lexer'')
=
mlp::parse (lookahead, *lexer', parse_error, err);
increment_linecount_by (lines_read ());
lexer' := lexer'';
if *saw_errors ERROR;
else PARSE result;
fi;
fi;
fi;
}
except
lrp::PARSE_ERROR => ABORT;
ABORT_LEX => ABORT;
end ;
\\ () = { saw_errors := FALSE;
#
prompt_read_parse_and_return_one_toplevel_nada_expression ();
};
};
};
end;