Commit 73b821ce authored by Juergen Nickelsen's avatar Juergen Nickelsen

correct exit status; *last-eval-stats*; fixed 031

parent 8b14eb1b
......@@ -15,7 +15,7 @@ my $debugfh = \*STDOUT;
BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw($Nil $T $n_Symbol $n_Pair $n_Function $n_function $special
$builtin $function
$builtin $function $n_last_eval_stats
$Quote error $Leval $andRest $Lambda $Princs $n_last_error
$n_ARGS our $t_Symbol $t_Number $t_String $t_Pair
$t_Function
......@@ -48,6 +48,7 @@ our $n_Pair = 'Pair';
our $n_Function = 'Function';
our $n_function = 'function';
our $n_last_error = '*last-error*';
our $n_last_eval_stats = '*last-eval-stats*';
our $n_ARGS = '*ARGS*';
our $Quote = 'quote';
......
......@@ -37,8 +37,9 @@ sub iEval {
my $start = time();
my $value = eval { Eval($expr); };
my $tdiff = time() - $start;
my $tdiff = time() - $start;
my $evals = eval_count();
my $pairs = cons_count();
if (defined($value)) {
Lprint($value);
......@@ -46,8 +47,12 @@ sub iEval {
} else {
say("Error: $@");
}
set(intern($n_last_eval_stats),
array2list(intern("evals"), $evals,
intern("pairs"), $pairs,
intern("s"), $tdiff));
printf(";; %d evals %d pairs in %d ms, %g evals/s\n",
$evals, cons_count(), int($tdiff * 1000),
$evals, $pairs, int($tdiff * 1000),
$tdiff ? $evals / $tdiff : "NaN")
unless $quiet;
return $value;
......@@ -56,19 +61,21 @@ sub iEval {
sub repl {
my ($fh, $interactive) = @_;
my $value;
my $value = 0;
while (1) {
if ($interactive) {
print("> ");
}
my $expr = eval {
my $expr = eval {
my $expr = Read($fh);
return $expr;
};
if ($@) {
say("Error: $@");
$value = undef;
next;
} elsif (!defined($expr)) {
# undef + !$@ is EOF
last;
}
......
......@@ -18,6 +18,7 @@ my $interactive = 1; # run interactively; this gets switched
# off by file and -e arguments
my $opt_quiet = 0; # be quiet
my $opt_interactive = 0; # interactive despite file or -e arg
my $error = 0; # potential error exit
my @argv_save = @ARGV;
......@@ -55,11 +56,15 @@ set(intern($n_ARGS), $Nil);
if (/-/) {
last ARGS2;
} elsif (/e/) {
eval_string(shift(@ARGV) || usage(1), $opt_quiet);
my $v = eval_string(shift(@ARGV) || usage(1),
$opt_quiet);
$error = !defined($v);
$interactive = 0;
} elsif (/h/) {
} elsif (/l/) {
load(shift(@ARGV) || usage(1), 0, $opt_quiet);
my $v = load(shift(@ARGV) || usage(1),
0, $opt_quiet);
$error = !defined($v);
} elsif (/i/) {
} elsif (/q/) {
} else {
......@@ -72,15 +77,17 @@ my $loadfile_arg = shift(@ARGV) // '';
set(intern($n_ARGS), array2list(@ARGV));
if ($loadfile_arg) {
load($loadfile_arg);
my $v = load($loadfile_arg);
$error = !defined($v);
$interactive = 0;
}
if ($interactive || $opt_interactive) {
repl(\*STDIN, !$opt_quiet);
my $v = repl(\*STDIN, !$opt_quiet);
print("\n");
$error = !defined($v);
}
exit(0);
exit($error);
########
......
......@@ -4,11 +4,11 @@
(testcmp "read error 1" '(or (errset (progn
(eval (read "(defun q (n) (* n n)"))
(q 13)))
(car (split-string *last-error* ": ")))
"EOF while reading list elements")
(cadr (split-string *last-error* ": ")))
"EOF reading list elements")
(testcmp "read error 2" '(or (errset (progn
(eval (read ")(defun q (n) (* n n))"))
(q 13)))
(car (split-string *last-error* ": ")))
(cadr (split-string *last-error* ": ")))
"close paren unexpected")
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