some half-baked improvements re error handling and reporting (43a09926) · Commits · lisp / lis.pl

Builtin.pm

+11 −43

Original line number	Diff line number	Diff line
		@@ -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 −18

Original line number	Diff line number	Diff line
		@@ -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);
		my $result = eval {
		if ($type eq "Symbol") {
		#debugl("expr is sym: %s", $ob);
		$result = symbol_value($ob);
		return error("unbound variable %s", symbol_name($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);
		$result = funcall($func, $args);
		return error("form yields undefined value: %s", princs($ob))
		my $result = funcall($func, $args);
		return error("form yields undefined value: %s",
		princs($ob))
		unless defined($result);
		return $result;
		} else {
		$result = $ob;
		return $ob;
		}
		};
		$eval_depth--;
		if ($@) {
		say("$eval_depth: ", princs($ob));
		error($@);
		}
		#debugl("eval expr: %s, returns %s", $ob, $result);
		return $result;
		}

Global.pm

+4 −1

Original line number	Diff line number	Diff line
		@@ -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