some half-baked improvements re error handling and reporting

Builtin.pm

@@ -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;
 }
 

Eval.pm

@@ -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;
 }

Global.pm

@@ -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