Commit 43a09926 authored by Juergen Nickelsen's avatar Juergen Nickelsen

some half-baked improvements re error handling and reporting

parent ebaf905c
......@@ -516,7 +516,8 @@ sub Blabels {
fset($sym, $func);
}
unless (defined($result)) {
say("labels: ", princs($arglist)) unless in_errset();
say("$eval_depth: labels: ", princs($arglist))
unless in_errset();
return error($@);
}
return $result;
......@@ -557,7 +558,8 @@ sub Blet_star {
};
backto_environment($saved_env);
unless (defined($result)) {
say("let*: ", princs(car($arglist))) unless in_errset();
say("$eval_depth: let*: ", princs(car($arglist)))
unless in_errset();
return error($@);
}
return $result;
......@@ -604,7 +606,8 @@ sub Blet {
};
backto_environment($saved_env);
unless (defined($result)) {
say("let: ", princs(car($arglist))) unless in_errset();
say("$eval_depth: let: ", princs(car($arglist)))
unless in_errset();
return error($@);
}
return $result;
......@@ -640,30 +643,17 @@ sub Beq {
sub Bif {
my ($condexpr, $thenclause, @elseclauses) = checkargs($_[0], 'eeR');
my $cond = eval { Eval($condexpr) };
unless (defined($cond)) {
say("if cond: ", princs($condexpr)) unless in_errset();
return error($@);
}
my $result = $Nil;
#debug("if is the biff");
my $clause;
if (!is_nil($cond)) {
$clause = $thenclause;
if (!is_nil(Eval($condexpr))) {
#debug("if evals then clause %s", $thenclause);
$result = eval { Eval($thenclause) };
$result = Eval($thenclause);
} else {
for $clause (@elseclauses) {
for my $clause (@elseclauses) {
#debug("if evals else clause %s", $clause);
$result = eval { Eval($clause) };
last unless defined($result);
$result = Eval($clause);
}
}
#debug("if returns %s", $result);
unless (defined($result)) {
say("if clause: ", princs($clause)) unless in_errset();
return error($@);
}
return $result;
}
......@@ -837,10 +827,6 @@ sub Band {
my $arg;
($arg, $arglist) = cxr($arglist);
my $value = Eval($arg);
unless (defined($value)) {
say("and: ", princs($arg)) unless in_errset();
return error($@);
}
return $Nil if is_nil($value);
$lastval = $value;
}
......@@ -853,10 +839,6 @@ sub Bor {
my $arg;
($arg, $arglist) = cxr($arglist);
my $value = Eval($arg);
unless (defined($value)) {
say("or: ", princs($arg)) unless in_errset();
return error($@);
}
return $value if !is_nil($value);
}
return $Nil;
......@@ -904,13 +886,7 @@ sub Bnum_less {
sub Bwhile {
my ($cond, $bodyforms) = checkargs($_[0], 'er');
while (1) {
my $cval = Eval($cond);
unless (defined($cval)) {
say("while cond: ", princs($cond)) unless in_errset();
return error($@);
}
last if is_nil($cval);
while (!is_nil(Eval($cond))) {
eval_forms($bodyforms);
}
return $Nil;
......@@ -924,10 +900,6 @@ sub Bset {
sub Bsetq {
my ($symbol, $value) = checkargs($_[0], 'ye');
my $evalue = Eval($value);
unless (defined($evalue)) {
say("setq value: ", princs($value)) unless in_errset();
return error($@);
}
return set($symbol, $evalue);
}
......@@ -970,10 +942,6 @@ sub Bapply {
sub Beval {
my ($expr) = checkargs($_[0], 'e');
my $evalue = Eval($expr);
unless (defined($evalue)) {
say("lisp eval: ", princs($expr)) unless in_errset();
return error($@);
}
return $evalue;
}
......
......@@ -25,7 +25,6 @@ BEGIN {
);
}
my $eval_depth = 0;
my $eval_counter = 0;
my $errset_level = 0;
......@@ -220,25 +219,33 @@ sub Eval {
$eval_depth++;
$eval_counter++;
my $result;
my $type = type_of($ob);
if ($type eq "Symbol") {
#debugl("expr is sym: %s", $ob);
$result = symbol_value($ob);
return error("unbound variable %s", symbol_name($ob))
unless defined($result);
} elsif ($type eq "Pair") {
#debugl("expr is cons: %s", $ob);
my $func = evalfun(car($ob));
my $args = cdr($ob);
$args = eval_args($args) unless specialp($func);
$result = funcall($func, $args);
return error("form yields undefined value: %s", princs($ob))
unless defined($result);
} else {
$result = $ob;
}
my $result = eval {
if ($type eq "Symbol") {
#debugl("expr is sym: %s", $ob);
my $result = symbol_value($ob);
error("unbound variable %s", symbol_name($ob))
unless defined($result);
return $result;
} elsif ($type eq "Pair") {
#debugl("expr is cons: %s", $ob);
my $func = evalfun(car($ob));
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))
unless defined($result);
return $result;
} else {
return $ob;
}
};
$eval_depth--;
if ($@) {
say("$eval_depth: ", princs($ob));
error($@);
}
#debugl("eval expr: %s, returns %s", $ob, $result);
return $result;
}
......
......@@ -23,10 +23,13 @@ BEGIN {
$t_Function $opt_stacktraces
$andOptional $n_Environment $n_parentenv
$n_root_environment $root_environment
$n_environment_level $n_env_name
$n_environment_level $n_env_name $eval_depth
);
}
# depth of the eval stack
our $eval_depth = 0;
# some symbols
our $Nil; # the nil symbol
our $T; # the t symbol
......
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