From b38e34fdec127166ac1e4a3db47c07c53959c677 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 31 Jul 2017 17:41:34 -0700 Subject: txr-016 2009-10-16 --- ChangeLog | 70 +++++++++++++++++++++++++++++ lib.c | 4 +- lib.h | 2 +- match.c | 83 +++++++++++++++++++++++++--------- parser.y | 41 +++++++++++------ txr.1 | 152 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-------- txr.c | 23 +++++----- unwind.c | 15 ++++--- unwind.h | 2 +- 9 files changed, 320 insertions(+), 72 deletions(-) diff --git a/ChangeLog b/ChangeLog index 25531be5..ea4a2f86 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,73 @@ +2009-10-16 Kaz Kylheku + + Version 016 + + Catch clauses with parameters. + + Directive for throwing exceptions: throw. + + Directive for defining exception types: defex. + + -f option renamed to -c. + + * txr.c: (version): Bump to 016 + * txr.1: Bump version to 016. + +2009-10-16 Kaz Kylheku + + * txr.c (help, main): Changed -f argument to -c. This + is consistent with the -c argument of the shell; + -f looks like awk's -f option, which specifies a file, + not a literal script body. + + * txr.1: Updated. + +2009-10-15 Kaz Kylheku + + * txr.1: Grammar, spelling. + +2009-10-15 Kaz Kylheku + + * parser.y (clauses_opt): Long overdue nonterminal added. + (define_clause) simplified with clauses_opt. + (try_clause): Error handling improved. + (catch_clauses_opt): Catch and finally clauses can be empty. + Error cases added. + * txr.1: Updated. + +2009-10-15 Kaz Kylheku + + * match.c (match_files): Use alist_remove1 for a one + element removal. + +2009-10-15 Kaz Kylheku + + * unwind.c (uw_throw): Add program prefix before + unhandled exception text. Print it in the + standard notation if it's not a string literal. + * match.c (sem_error, file_err): Don't stick program + prefix into exception text. + +2009-10-15 Kaz Kylheku + + * unwind.c (uw_exception_subtype_p, uw_init): + Slight change in representation for exception subtypes, + saving one node in the list. + +2009-10-15 Kaz Kylheku + + New throw and defex directives, catches with arguments. + + * lib.c (defex, throw): New symbol globals. + (obj_init): Symbols interned. + * lib.h (defex, throw): Declared. + * match.c (match_files): Implemented throw and defex. + Argument handling in catches. + * unwind.c (uw_register_subtype): Returns right + argument, so we can cleverly use it with reduce_left. + * unwind.h (uw_register_subtype): Declaration updated. + * txr.1: Updated. + 2009-10-14 Kaz Kylheku Version 015 diff --git a/lib.c b/lib.c index afad3fe2..0072f929 100644 --- a/lib.c +++ b/lib.c @@ -50,7 +50,7 @@ obj_t *skip, *trailer, *block, *next, *fail, *accept; obj_t *all, *some, *none, *maybe, *cases, *collect, *until, *coll; obj_t *define, *output, *single, *frst, *lst, *empty, *repeat, *rep; obj_t *flattn, *forget, *local, *mrge, *bind, *cat, *dir; -obj_t *try, *catch, *finally, *nothrow; +obj_t *try, *catch, *finally, *nothrow, *throw, *defex; obj_t *error, *type_error, *internal_err, *numeric_err, *range_err; obj_t *query_error, *file_error; @@ -1521,6 +1521,8 @@ static void obj_init(void) catch = intern(string(strdup("catch"))); finally = intern(string(strdup("finally"))); nothrow = intern(string(strdup("nothrow"))); + throw = intern(string(strdup("throw"))); + defex = intern(string(strdup("defex"))); error = intern(string(strdup("error"))); type_error = intern(string(strdup("type_error"))); internal_err = intern(string(strdup("internal_error"))); diff --git a/lib.h b/lib.h index 1ecb577d..9473a299 100644 --- a/lib.h +++ b/lib.h @@ -149,7 +149,7 @@ extern obj_t *skip, *trailer, *block, *next, *fail, *accept; extern obj_t *all, *some, *none, *maybe, *cases, *collect, *until, *coll; extern obj_t *define, *output, *single, *frst, *lst, *empty, *repeat, *rep; extern obj_t *flattn, *forget, *local, *mrge, *bind, *cat, *dir; -extern obj_t *try, *catch, *finally, *nothrow; +extern obj_t *try, *catch, *finally, *nothrow, *throw, *defex; extern obj_t *error, *type_error, *internal_err, *numeric_err, *range_err; extern obj_t *query_error, *file_error; diff --git a/match.c b/match.c index d14df9a3..babaab18 100644 --- a/match.c +++ b/match.c @@ -85,7 +85,6 @@ static void sem_error(obj_t *line, const char *fmt, ...) obj_t *stream = make_string_output_stream(); va_start (vl, fmt); - format(stream, "~a: ", prog_string, nao); if (line) format(stream, "(~a:~a) ", spec_file_str, line, nao); (void) vformat(stream, fmt, vl); @@ -101,7 +100,6 @@ static void file_err(obj_t *line, const char *fmt, ...) obj_t *stream = make_string_output_stream(); va_start (vl, fmt); - format(stream, "~a: ", prog_string, nao); if (line) format(stream, "(~a:~a) ", spec_file_str, line, nao); (void) vformat(stream, fmt, vl); @@ -1402,7 +1400,7 @@ repeat_spec_same_data: { uw_block_begin(nil, result); - uw_catch_begin(catch_syms, exsym, exception); + uw_catch_begin(catch_syms, exsym, exvals); { result = match_files(try_clause, files, bindings, @@ -1410,32 +1408,54 @@ repeat_spec_same_data: uw_do_unwind; } - uw_catch(exsym, exception) { + uw_catch(exsym, exvals) { { obj_t *iter; for (iter = catch_fin; iter; iter = cdr(iter)) { obj_t *clause = car(iter); - obj_t *matches = second(clause); + obj_t *type = first(second(clause)); + obj_t *params = second(second(clause)); obj_t *body = third(clause); + obj_t *vals = if3(listp(exvals), + exvals, + cons(cons(t, exvals), nil)); if (first(clause) == catch) { - obj_t *match; - for (match = matches; match; match = cdr(match)) - if (uw_exception_subtype_p(exsym, car(match))) - break; - if (match) { - cons_bind (new_bindings, success, - match_files(body, files, bindings, - data, num(data_lineno))); - if (success) { - bindings = new_bindings; - result = t; /* catch succeeded, so try succeeds */ - if (consp(success)) { - data = car(success); - data_lineno = c_num(cdr(success)); - } else { - data = nil; + if (uw_exception_subtype_p(exsym, type)) { + obj_t *all_bind = t; + obj_t *piter, *viter; + + for (piter = params, viter = vals; + piter && viter; + piter = cdr(piter), viter = cdr(viter)) + { + obj_t *param = car(piter); + obj_t *val = car(viter); + + if (val) { + bindings = dest_bind(bindings, param, cdr(val)); + + if (bindings == t) { + all_bind = nil; + break; + } + } + } + + if (all_bind) { + cons_bind (new_bindings, success, + match_files(body, files, bindings, + data, num(data_lineno))); + if (success) { + bindings = new_bindings; + result = t; /* catch succeeded, so try succeeds */ + if (consp(success)) { + data = car(success); + data_lineno = c_num(cdr(success)); + } else { + data = nil; + } } } break; @@ -1504,6 +1524,25 @@ repeat_spec_same_data: goto repeat_spec_same_data; } + } else if (sym == defex) { + obj_t *types = rest(first_spec); + if (!all_satisfy(types, func_n1(symbolp), nil)) + sem_error(spec_linenum, "defex arguments must all be symbols", nao); + (void) reduce_left(func_n2(uw_register_subtype), types, nil, nil); + if ((spec = rest(spec)) == nil) + break; + goto repeat_spec_same_data; + } else if (sym == throw) { + obj_t *type = second(first_spec); + obj_t *args = rest(rest(first_spec)); + if (!symbolp(type)) + sem_error(spec_linenum, "throw: ~a is not a type symbol", + first(first_spec), nao); + { + obj_t *values = mapcar(bind2other(func_n2(eval_form), bindings), + args); + uw_throw(type, values); + } } else { obj_t *func = uw_get_func(sym); @@ -1532,7 +1571,7 @@ repeat_spec_same_data: param, cdr(val)); } else { - bindings_cp = alist_remove(bindings_cp, cons(param, nil)); + bindings_cp = alist_remove1(bindings_cp, param); ub_p_a_pairs = cons(cons(param, arg), ub_p_a_pairs); } } else { diff --git a/parser.y b/parser.y index 9b440919..405e63d1 100644 --- a/parser.y +++ b/parser.y @@ -58,7 +58,8 @@ static obj_t *parsed_spec; %token NUMBER %token REGCHAR LITCHAR -%type spec clauses clause all_clause some_clause none_clause maybe_clause +%type spec clauses clauses_opt clause +%type all_clause some_clause none_clause maybe_clause %type cases_clause collect_clause clause_parts additional_parts %type output_clause define_clause try_clause catch_clauses_opt %type line elems_opt elems elem var var_op @@ -80,7 +81,7 @@ static obj_t *parsed_spec; %% spec : clauses { parsed_spec = $1; } - | { parsed_spec = nil; } + | /* empty */ { parsed_spec = nil; } | error { parsed_spec = nil; yybadtoken(yychar, 0); } ; @@ -89,6 +90,10 @@ clauses : clause { $$ = cons($1, nil); } | clause clauses { $$ = cons($1, $2); } ; +clauses_opt : clauses { $$ = $1; } + | /* empty */ { $$ = nil; } + ; + clause : all_clause { $$ = list(num(lineno - 1), $1, nao); } | some_clause { $$ = list(num(lineno - 1), $1, nao); } | none_clause { $$ = list(num(lineno - 1), $1, nao); } @@ -190,15 +195,11 @@ elem : TEXT { $$ = string($1); } ; define_clause : DEFINE exprs ')' newl - clauses + clauses_opt END newl { $$ = list(define, $2, $5, nao); } | DEFINE ')' newl - clauses + clauses_opt END newl { $$ = list(define, nil, $4, nao); } - | DEFINE exprs ')' newl - END newl { $$ = list(define, $2, nao); } - | DEFINE ')' newl - END newl { $$ = list(define, nao); } | DEFINE error { yybadtoken(yychar, "list expression"); } | DEFINE exprs ')' newl error { yybadtoken(yychar, "define"); } @@ -214,23 +215,37 @@ try_clause : TRY newl $4)), $3, $4, nao); } | TRY newl + error { $$ = nil; + if (yychar == END || yychar == CATCH || + yychar == FINALLY) + yyerror("empty try clause"); + else + yybadtoken(yychar, "try clause"); } + | TRY newl + clauses error { $$ = nil; yybadtoken(yychar, "try clause"); } ; catch_clauses_opt : CATCH ')' newl - clauses - catch_clauses_opt { $$ = cons(list(catch, nil, $4, nao), - $5); } + clauses_opt + catch_clauses_opt { $$ = cons(list(catch, cons(t, nil), + $4, nao), $5); } | CATCH exprs ')' newl - clauses + clauses_opt catch_clauses_opt { $$ = cons(list(catch, $2, $5, nao), $6); } | FINALLY newl - clauses { $$ = cons(list(finally, nil, + clauses_opt { $$ = cons(list(finally, nil, $3, nao), nil); } | { $$ = nil; } + | CATCH ')' newl + error { yybadtoken(yychar, "try clause"); } + | CATCH exprs ')' newl + error { yybadtoken(yychar, "try clause"); } + | FINALLY newl + error { yybadtoken(yychar, "try clause"); } ; diff --git a/txr.1 b/txr.1 index cbc6887a..6cdc4401 100644 --- a/txr.1 +++ b/txr.1 @@ -21,7 +21,7 @@ .\"IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED .\"WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. -.TH txr 1 2009-10-14 "txr v. 015" "Text Extraction Utility" +.TH txr 1 2009-10-14 "txr v. 016" "Text Extraction Utility" .SH NAME txr \- text extractor .SH SYNOPSIS @@ -76,7 +76,7 @@ from their subqueries in special ways. .SH ARGUMENTS AND OPTIONS -Options other than -D, -a and -f may be combined together into a single +Options other than -D, -a and -c may be combined together into a single argument. The -v and -q options are mutually exclusive. The one which occurs in the rightmost position in the argument list dominates. @@ -135,12 +135,12 @@ reported as: The leftmost bracketed index is the most major index. That is to say, the dimension order is: NAME_m_m+1_..._n[1][2]...[m-1]. -.IP -f query +.IP -c query Specifies the query in the form of a command line argument. If this option is used, the query-file argument is omitted. The first non-option argument, if there is one, now specifies the first input source rather than a query. Queries specified as arguments must properly end in a newline, as if they -were read from a text file, thus -f "@a" is not a properly formed query. +were read from a text file, thus -c "@a" is not a properly formed query. Example: @@ -149,7 +149,7 @@ Example: # input is specified as - and the data # comes from shell "here document" redirection. - txr -f "@a + txr -c "@a @b " - <= 1) { + obj_t *s = stringp(exception); format(std_error, "~a: unhandled exception of type ~a:\n", prog_string, sym, nao); - format(std_error, "~a\n", exception, nao); + format(std_error, s ? "~a: ~a\n" : "~a: ~s\n", + prog_string, exception, nao); } if (uw_exception_subtype_p(sym, query_error) || uw_exception_subtype_p(sym, file_error)) { @@ -301,7 +303,7 @@ obj_t *type_mismatch(const char *fmt, ...) abort(); } -void uw_register_subtype(obj_t *sub, obj_t *sup) +obj_t *uw_register_subtype(obj_t *sub, obj_t *sup) { obj_t *t_entry = assoc(exception_subtypes, t); obj_t *sub_entry = assoc(exception_subtypes, sub); @@ -310,11 +312,11 @@ void uw_register_subtype(obj_t *sub, obj_t *sup) assert (t_entry != 0); if (sub == nil) - return; + return sup; if (sub == t) { if (sup == t) - return; + return sup; abort(); } @@ -334,6 +336,7 @@ void uw_register_subtype(obj_t *sub, obj_t *sup) /* Register sub as an immediate subtype of sup. */ sub_entry = cons(sub, sup_entry); exception_subtypes = cons(sub_entry, exception_subtypes); + return sup; } void uw_continue(uw_frame_t *current, uw_frame_t *cont) @@ -346,7 +349,7 @@ void uw_continue(uw_frame_t *current, uw_frame_t *cont) void uw_init(void) { protect(&toplevel_env.ev.func_bindings, &exception_subtypes, 0); - exception_subtypes = cons(cons(t, cons(t, nil)), exception_subtypes); + exception_subtypes = cons(cons(t, nil), exception_subtypes); uw_register_subtype(type_error, error); uw_register_subtype(internal_err, error); uw_register_subtype(numeric_err, error); diff --git a/unwind.h b/unwind.h index 574794b2..74d3e920 100644 --- a/unwind.h +++ b/unwind.h @@ -83,7 +83,7 @@ noreturn obj_t *uw_throwf(obj_t *sym, const char *fmt, ...); noreturn obj_t *uw_errorf(const char *fmt, ...); noreturn obj_t *uw_throwcf(obj_t *sym, const char *fmt, ...); noreturn obj_t *uw_errorcf(const char *fmt, ...); -void uw_register_subtype(obj_t *sub, obj_t *super); +obj_t *uw_register_subtype(obj_t *sub, obj_t *super); obj_t *uw_exception_subtype_p(obj_t *sub, obj_t *sup); void uw_continue(uw_frame_t *curr, uw_frame_t *target); void uw_pop_frame(uw_frame_t *); -- cgit v1.2.3