diff options
| -rw-r--r-- | eval.c | 1 | ||||
| -rw-r--r-- | parser.c | 30 | ||||
| -rw-r--r-- | parser.h | 6 | ||||
| -rw-r--r-- | parser.l | 11 | ||||
| -rw-r--r-- | parser.y | 44 | ||||
| -rw-r--r-- | txr.1 | 38 |
6 files changed, 120 insertions, 10 deletions
@@ -4615,6 +4615,7 @@ void eval_init(void) reg_fun(intern(lit("eval"), user_package), func_n2o(eval_intrinsic, 1)); reg_fun(intern(lit("lisp-parse"), user_package), func_n5o(lisp_parse, 0)); reg_fun(intern(lit("read"), user_package), func_n5o(lisp_parse, 0)); + reg_fun(intern(lit("iread"), user_package), func_n5o(iread, 0)); reg_fun(intern(lit("load"), system_package), func_n2(sys_load)); reg_fun(intern(lit("expand"), system_package), func_n2o(expand, 1)); reg_fun(intern(lit("macro-form-p"), user_package), func_n2o(macro_form_p, 1)); @@ -176,6 +176,9 @@ void prime_parser(parser_t *p, val name, enum prime_parser prim) case prime_lisp: sec_tok.yy_char = SECRET_ESCAPE_E; break; + case prime_interactive: + sec_tok.yy_char = SECRET_ESCAPE_I; + break; case prime_regex: sec_tok.yy_char = SECRET_ESCAPE_R; break; @@ -188,6 +191,12 @@ void prime_parser(parser_t *p, val name, enum prime_parser prim) set(mkloc(p->name, p->parser), name); } +void prime_parser_post(parser_t *p, enum prime_parser prim) +{ + if (prim == prime_interactive) + p->recent_tok.yy_char = 0; +} + void open_txr_file(val spec_file, val *txr_lisp_p, val *name, val *stream) { enum { none, tl, txr } suffix; @@ -277,8 +286,8 @@ val regex_parse(val string, val error_stream) return parser.errors ? nil : parser.syntax_tree; } -val lisp_parse(val source_in, val error_stream, val error_return_val, - val name_in, val lineno) +static val lisp_parse_impl(val interactive, val source_in, val error_stream, + val error_return_val, val name_in, val lineno) { uses_or2; val source = default_bool_arg(source_in); @@ -309,7 +318,8 @@ val lisp_parse(val source_in, val error_stream, val error_return_val, { int gc = gc_state(0); - parse(pi, if3(std_error != std_null, name, lit("")), prime_lisp); + enum prime_parser prime = if3(interactive, prime_interactive, prime_lisp); + parse(pi, if3(std_error != std_null, name, lit("")), prime); gc_state(gc); parsed = t; } @@ -335,6 +345,20 @@ val lisp_parse(val source_in, val error_stream, val error_return_val, return pi->syntax_tree; } +val lisp_parse(val source_in, val error_stream, val error_return_val, + val name_in, val lineno) +{ + return lisp_parse_impl(nil, source_in, error_stream, error_return_val, + name_in, lineno); +} + +val iread(val source_in, val error_stream, val error_return_val, + val name_in, val lineno) +{ + return lisp_parse_impl(t, source_in, error_stream, error_return_val, + name_in, lineno); +} + val read_eval_stream(val stream, val error_stream, val hash_bang_support) { val error_val = gensym(nil); @@ -55,7 +55,7 @@ struct parser { }; #endif -enum prime_parser { prime_lisp, prime_regex }; +enum prime_parser { prime_lisp, prime_interactive, prime_regex }; extern const int have_yydebug; extern const wchar_t *spec_file; @@ -80,7 +80,9 @@ void yyset_hold_char(yyscan_t, int); void parser_l_init(void); void open_txr_file(val spec_file, val *txr_lisp_p, val *name, val *stream); void prime_parser(parser_t *, val name, enum prime_parser); +void prime_parser_post(parser_t *, enum prime_parser); void prime_scanner(scanner_t *, enum prime_parser); +void scrub_scanner(scanner_t *, int yy_char, wchar_t *lexeme); int parse_once(val stream, val name, parser_t *parser); int parse(parser_t *parser, val name, enum prime_parser); val source_loc(val form); @@ -95,6 +97,8 @@ val rlcp_tree(val to, val from); val regex_parse(val string, val error_stream); val lisp_parse(val source_in, val error_stream, val error_return_val, val name_in, val lineno); +val iread(val source_in, val error_stream, val error_return_val, + val name_in, val lineno); val read_eval_stream(val stream, val error_stream, val hash_bang_support); #if HAVE_TERMIOS val repl(val bindings, val in_stream, val out_stream); @@ -1065,6 +1065,7 @@ void prime_scanner(scanner_t *yyg, enum prime_parser prim) switch (prim) { case prime_lisp: + case prime_interactive: yy_push_state(SPECIAL, yyg); yy_push_state(NESTED, yyg); yy_push_state(NESTED, yyg); @@ -1075,6 +1076,16 @@ void prime_scanner(scanner_t *yyg, enum prime_parser prim) } } +void scrub_scanner(scanner_t *yyg, int yy_char, wchar_t *lexeme) +{ + struct yy_token *rtok = &yyextra->recent_tok; + + if (rtok->yy_char == yy_char && rtok->yy_lval.lexeme == lexeme) { + rtok->yy_char = 0; + rtok->yy_lval.lexeme = 0; + } +} + void parser_l_init(void) { prot1(&form_to_ln_hash); @@ -102,7 +102,7 @@ int yyparse(scanner_t *, parser_t *); %token <lineno> ERRTOK /* deliberately not used in grammar */ %token <lineno> HASH_BACKSLASH HASH_SLASH DOTDOT HASH_H HASH_S HASH_R %token <lineno> WORDS WSPLICE QWORDS QWSPLICE -%token <lineno> SECRET_ESCAPE_R SECRET_ESCAPE_E +%token <lineno> SECRET_ESCAPE_R SECRET_ESCAPE_E SECRET_ESCAPE_I %token <val> NUMBER METANUM @@ -117,7 +117,7 @@ int yyparse(scanner_t *, parser_t *); %type <val> if_clause elif_clauses_opt else_clause_opt %type <val> line elems_opt elems clause_parts_h additional_parts_h %type <val> text texts elem var var_op modifiers vector hash struct range -%type <val> list exprs exprs_opt expr n_exprs r_exprs n_expr n_exprs_opt +%type <val> list exprs exprs_opt expr n_exprs r_exprs i_expr n_expr n_exprs_opt %type <val> out_clauses out_clauses_opt out_clause %type <val> repeat_clause repeat_parts_opt o_line %type <val> o_elems_opt o_elems o_elem o_var q_var rep_elem rep_parts_opt @@ -149,6 +149,8 @@ spec : clauses { parser->syntax_tree = $1; } | SECRET_ESCAPE_R regexpr { parser->syntax_tree = $2; end_of_regex(scnr); } | SECRET_ESCAPE_E n_expr { parser->syntax_tree = $2; YYACCEPT; } byacc_fool { internal_error("notreached"); } + | SECRET_ESCAPE_I i_expr { parser->syntax_tree = $2; YYACCEPT; } + byacc_fool { internal_error("notreached"); } | SECRET_ESCAPE_E { if (yychar == YYEOF) { parser->syntax_tree = nao; YYACCEPT; @@ -156,6 +158,13 @@ spec : clauses { parser->syntax_tree = $1; } yybadtok(yychar, nil); parser->syntax_tree = nil; } } + | SECRET_ESCAPE_I { if (yychar == YYEOF) { + parser->syntax_tree = nao; + YYACCEPT; + } else { + yybadtok(yychar, nil); + parser->syntax_tree = nil; + } } | error '\n' { parser->syntax_tree = nil; if (parser->errors >= 8) YYABORT; @@ -820,6 +829,31 @@ r_exprs : n_expr { val exprs = cons($1, nil); $$ = term_atom_cons; } ; +i_expr : SYMTOK { $$ = symhlpr($1, t); } + | METANUM { $$ = cons(var_s, cons($1, nil)); + rl($$, num(parser->lineno)); } + | NUMBER { $$ = $1; } + | list { $$ = $1; } + | vector { $$ = $1; } + | hash { $$ = $1; } + | struct { $$ = $1; } + | range { $$ = $1; } + | lisp_regex { $$ = $1; } + | chrlit { $$ = $1; } + | strlit { $$ = $1; } + | quasilit { $$ = $1; } + | WORDS wordslit { $$ = rl($2, num($1)); } + | QWORDS wordsqlit { $$ = rl(cons(quasilist_s, $2), num($1)); } + | '\'' i_expr { $$ = rl(rlcp(list(quote_s, $2, nao), $2), + num(parser->lineno)); } + | '^' i_expr { $$ = rl(rlcp(list(sys_qquote_s, $2, nao), $2), + num(parser->lineno)); } + | ',' i_expr { $$ = rl(rlcp(list(sys_unquote_s, $2, nao), $2), + num(parser->lineno)); } + | SPLICE i_expr { $$ = rl(rlcp(list(sys_splice_s, $2, nao), $2), + num(parser->lineno)); } + ; + n_expr : SYMTOK { $$ = symhlpr($1, t); } | METANUM { $$ = cons(var_s, cons($1, nil)); rl($$, num(parser->lineno)); } @@ -1107,11 +1141,13 @@ static val sym_helper(parser_t *parser, wchar_t *lexeme, val meta_allowed) if (colon == lexeme) { package = keyword_package_var; sym_name = string(colon + 1); + scrub_scanner(parser->scanner, SYMTOK, tokfree); free(tokfree); } else if (colon != 0) { pkg_name = string(lexeme); package = find_package(pkg_name); sym_name = string(colon + 1); + scrub_scanner(parser->scanner, SYMTOK, tokfree); free(tokfree); if (!package) { yyerrorf(scnr, lit("~a:~a: package ~a not found"), pkg_name, sym_name, pkg_name, nao); @@ -1119,6 +1155,7 @@ static val sym_helper(parser_t *parser, wchar_t *lexeme, val meta_allowed) } } else { sym_name = string(lexeme); + scrub_scanner(parser->scanner, SYMTOK, tokfree); free(tokfree); } @@ -1543,12 +1580,15 @@ int parse(parser_t *parser, val name, enum prime_parser prim) parser->errors = 0; parser->prepared_msg = nil; parser->syntax_tree = nil; + prime_parser(parser, name, prim); uw_catch_begin(cons(error_s, nil), esym, eobj); res = yyparse(parser->scanner, parser); + prime_parser_post(parser, prim); + uw_catch(esym, eobj) { yyerrorf(parser->scanner, lit("exception during parse"), nao); uw_throw(esym, eobj); @@ -32070,9 +32070,10 @@ Examples of strings which are not absolute paths. $:\eabc .cble -.coNP Function @ read +.coNP Functions @ read and @ iread .synb -.mets (read >> [ source >> [ error-stream >> [ error-return-value <> [ name ]]]]) +.mets (read >> [ source >> [ error-stream >> [ error-retval <> [ name ]]]]) +.mets (iread >> [ source >> [ error-stream >> [ error-retval <> [ name ]]]]) .syne .desc The @@ -32110,15 +32111,44 @@ is a string. If there are no parse errors, the function returns the parsed data structure. If there are parse errors, and the -.meta error-return-value +.meta error-retval parameter is present, its value is returned. If the -.meta error-return-value +.meta error-retval parameter is not present, then an exception of type .code syntax-error is thrown. +The +.code iread +function ("interactive read") is similar to +.code read +except that it parses a modified version of the syntax. The modified +syntax does not support the application of the dot and dotdot operators +on a toplevel expression. For instance, if the input is +.code a.b +or +.code a .. b +then +.code iread +will only read the +.code a +token whereas +.code read +will read the entire expression. + +This modified syntax allows +.code iread +to return immediately when an expression is recognized, which is the +expected behavior if the input is being read from an interactive terminal. +By contrast, +.code read +waits for more input after seeing a complete expression, because of the +possibility that the expression will be further extended by means of the dot or +dotdot operators. An explicit end-of-input signal must be given from the +terminal to terminate the expression. + .SS* Stream Output Indentation \*(TL streams provide support for establishing hanging indentations in text output. Each stream which supports output has a built-in state variable |