Commit 4c45502a authored by Juergen Nickelsen's avatar Juergen Nickelsen

straightened and simplified error handling all over the place

In the beginning I wasn't sure if I perhaps should make errors return
a value (e.g. undef, or an error object of some kind) or let it throw
an exception. it was the latter then, but there were many remains of
the former ("return error(...") everywhere. That didn't matter a lot,
but over the time had become a nuisance.

And then there were notions of catching and somehow acting on the error
before passing it on that were unneeded in between or simply wrong. All
these have been straightened, and errors are now caught only in places
where things must be restored to a previous state (let, labels, eval_form)
or where a traceback shall be printed.
parent fe32ccc0
......@@ -164,9 +164,7 @@ sub Bdolist {
return Eval($resultform);
};
backto_environment($saved_env);
if ($@) {
return error($@);
}
error($@) if $@;
return $result;
}
......@@ -407,9 +405,7 @@ sub Bre_subst {
my $code = "s{$regexp}{$subst}$options";
#warn("re-subst: >>$code<<");
eval($code);
if ($@) {
error("re-subst: $@");
}
error($@) if $@;
return $_;
}
......@@ -515,11 +511,7 @@ sub Blabels {
#debug("restore symbol %s to function %s", $sym, $func);
fset($sym, $func);
}
unless (defined($result)) {
say("$eval_depth: labels: ", princs($arglist))
unless in_errset();
return error($@);
}
error ($@) if $@;
return $result;
}
......@@ -557,11 +549,7 @@ sub Blet_star {
return $result;
};
backto_environment($saved_env);
unless (defined($result)) {
say("$eval_depth: let*: ", princs(car($arglist)))
unless in_errset();
return error($@);
}
error ($@) if $@;
return $result;
}
......@@ -605,11 +593,7 @@ sub Blet {
return $result;
};
backto_environment($saved_env);
unless (defined($result)) {
say("$eval_depth: let: ", princs(car($arglist)))
unless in_errset();
return error($@);
}
error ($@) if $@;
return $result;
}
......@@ -862,7 +846,6 @@ sub Bdump {
sub Bperl {
my ($expr) = checkargs($_[0], 'S');
my $result = eval $expr;
return error($@) if $@;
return $result;
}
......
......@@ -137,12 +137,12 @@ sub call_form {
return $result;
};
backto_environment($saved_env);
# return error after restoring bindings
# error after restoring bindings
unless (defined($result)) {
say("$eval_depth: ", princs(cons(function_name($func),
$orig_args)))
unless in_errset();
return error($@);
error($@);
}
return $result;
}
......@@ -174,7 +174,7 @@ sub evalfun {
$result = $ob;
last;
} elsif (is_nil($ob)) {
return error("nil function %s", $orig);
error("nil function %s", $orig);
} elsif ($type eq "Symbol") {
my $symbol = $ob;
if (my $func = symbol_function($ob)) {
......@@ -186,20 +186,19 @@ sub evalfun {
#debugl("evalfun symbol %s yields value:",
# $symbol, $ob);
}
return error("undefined function %s",
error("undefined function %s",
symbol_name($symbol))
unless defined($ob);
} elsif ($type eq "Pair") {
my $form = $ob;
$ob = Eval($ob);
#debugl("evalfun form %s returns %s", $form, $ob);
return error("function form yields undefined: %s",
$form)
error("function form yields undefined: %s", $form)
unless defined($ob);
} elsif ($type eq "undef") {
return error("undefined function %s", $orig);
error("undefined function %s", $orig);
} else {
return error("not a function: %s", $orig);
error("not a function: %s", $orig);
}
}
error("cyclic non-function?: %s", $orig) unless $max;
......@@ -233,8 +232,7 @@ sub Eval {
my $args = cdr($ob);
$args = eval_args($args) unless specialp($func);
my $result = funcall($func, $args);
return error("form yields undefined value: %s",
princs($ob))
error("form yields undefined value: %s", princs($ob))
unless defined($result);
return $result;
} else {
......
......@@ -102,7 +102,7 @@ sub load {
say("cannot open file ($!): %s", $fname);
return $Nil;
}
return error("cannot open file ($!) %s", $fname);
error("cannot open file ($!) %s", $fname);
}
print(";; loading file $fname ... ") unless $nomessage;
$| = 1;
......
......@@ -244,10 +244,10 @@ sub function {
} elsif (ref($func) eq $n_Pair) {
$type = 'expr';
} else {
return error('function not subr or expr: %s', $func);
error('function not subr or expr: %s', $func);
}
$env //= $Env;
return error('function: is_special undef: %s', $func)
error('function: is_special undef: %s', $func)
unless defined($is_special);
return bless({ func => $func, type => $type, spec => $is_special,
doc => $doc // '', name => $name, env => $env },
......
......@@ -67,27 +67,24 @@ sub Read {
my $list = read_list_elems($in);
return undef unless defined($list);
my $closer = next_token($in);
return read_error($in, "list closed by $closer")
unless $closer eq ')';
read_error($in, "list closed by $closer") unless $closer eq ')';
return $list;
} elsif ($t eq '\'') {
$t = Read($in);
return read_error($in, "EOF in quote")
unless defined($t);
read_error($in, "EOF in quote") unless defined($t);
return cons(intern($n_Quote), cons($t, $Nil));
} elsif ($t eq '#\'') {
$t = Read($in);
return read_error($in, "EOF in #quote")
unless defined($t);
read_error($in, "EOF in #quote") unless defined($t);
return cons(intern($n_function), cons($t, $Nil));
} elsif ($t eq '.') {
return read_error($in, "found . when expecting sexpr");
read_error($in, "found . when expecting sexpr");
} elsif (symbolp($t)) {
return $t;
} elsif ($t =~ m{^\"}) {
return substr($t, 1);
} elsif ($t eq ')') {
return read_error($in, "close paren unexpected");
read_error($in, "close paren unexpected");
} else {
return $t;
}
......@@ -104,13 +101,11 @@ sub read_list_elems {
push_back_token($t);
return $list;
} elsif ($t eq '.') {
return read_error($in, ". at start of list")
unless $end;
read_error($in, ". at start of list") unless $end;
my $sexpr = Read($in);
return undef unless defined($t);
$t = next_token($in);
return
read_error($in, "no ) after end of improper list")
read_error($in, "no ) after end of improper list")
unless $t eq ')';
rplacd($end, $sexpr);
push_back_token($t);
......@@ -127,7 +122,7 @@ sub read_list_elems {
}
}
}
return read_error($in, "EOF reading list elements");
read_error($in, "EOF reading list elements");
}
......@@ -189,7 +184,7 @@ sub read_string {
$s .= $c;
}
}
return error_or_eof($in) unless $c eq '"';
error_or_eof($in) unless $c eq '"';
return $s;
}
......@@ -208,24 +203,23 @@ sub symbol_or_number_or_dot {
sub error_or_eof {
my ($in) = @_;
if (defined($!)) {
return read_error($in, "read failure: $!");
read_error($in, "read failure: $!");
}
return read_error($in, "unexpected EOF");
read_error($in, "unexpected EOF");
}
sub read_macro {
my ($in) = @_;
#debug("read macro");
my $c = next_nonwhite($in);
return read_error($in, "unexpected EOF")
unless defined($c);
read_error($in, "unexpected EOF") unless defined($c);
if ($c eq '\'') {
my $result = '#\'';
#debug("read macro returns %s", $result);
return $result;
# and possibly more
} else {
return read_error($in, "unknown reader macro \"#$c\"");
read_error($in, "unknown reader macro \"#$c\"");
}
}
......
......@@ -31,8 +31,8 @@ sub caller_name {
sub arg_type_error {
my ($argno, $type, $arg) = @_;
return error("argument %d to builtin function %s is not a %s: %s",
$argno, caller_name(2), $type, $arg);
error("argument %d to builtin function %s is not a %s: %s",
$argno, caller_name(2), $type, $arg);
}
# check arguments; descriptor is string "xxx:xx" with mandatory args
......@@ -81,8 +81,8 @@ sub checkargs {
$optional = 1;
next;
}
return error("too few arguments to function %s: %s",
caller_name(1), $argno)
error("too few arguments to function %s: %s",
caller_name(1), $argno)
unless $optional || consp($arglist);
my $arg;
($arg, $arglist) = cxr($arglist);
......@@ -155,23 +155,23 @@ sub list2array {
# value is defined
sub is_def {
my ($arg) = @_;
return error("undefined argument") unless defined($arg);
error("undefined argument") unless defined($arg);
return $arg;
}
# value is defined and a symbol
sub is_sym {
my ($arg) = @_;
return error("undefined argument") unless defined($arg);
return error("not a symbol: %s", $arg) unless symbolp($arg);
error("undefined argument") unless defined($arg);
error("not a symbol: %s", $arg) unless symbolp($arg);
return $arg;
}
# value is defined and a list
sub is_list {
my ($arg) = @_;
return error("undefined argument") unless defined($arg);
return error("not a list: %s", $arg) unless listp($arg);
error("undefined argument") unless defined($arg);
error("not a list: %s", $arg) unless listp($arg);
return $arg;
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment