Commit d299337a authored by Juergen Nickelsen's avatar Juergen Nickelsen

improved Read error messages; filename + linenumber for load files

parent 02ea4b5f
......@@ -98,8 +98,10 @@ sub load {
}
print(";; loading file $fname ... ") unless $nomessage;
$| = 1;
start_file($fname);
my $result = repl($fh, 0);
close($fh);
end_file();
if (defined($result) && !$nomessage) {
say("done");
}
......
......@@ -17,7 +17,7 @@ use Exporter ();
BEGIN {
@ISA = qw(Exporter);
@EXPORT = qw( Read
@EXPORT = qw( Read start_file end_file
);
}
......@@ -25,11 +25,30 @@ my $default_input = \*STDIN;
my $sepchars = quotemeta("();\n");
my $linecount;
my $filename;
sub start_file {
my ($fname) = @_;
$linecount = 1;
$filename = $fname;
}
sub end_file {
undef($linecount);
undef($filename);
}
# after a read error, consume to end of line
sub read_error {
my ($in, @rest) = @_;
my ($in, $format, @args) = @_;
<$in>;
error(@rest);
if ($filename) {
print STDERR ("\n\n$filename:$linecount: $format\n", @args);
error("in $filename");
} else {
error($format, @args);
}
}
sub Read {
......@@ -38,8 +57,7 @@ sub Read {
if (stringp($in)) {
my $string = $in;
open(my $str_in, "<", \$string) or
read_error($in,
"read: cannot open string as filehandle: $!\n");
error("read: cannot open string as filehandle: $!\n");
$in = $str_in;
}
......@@ -50,22 +68,21 @@ sub Read {
my $list = read_list_elems($in);
return undef unless defined($list);
my $closer = next_token($in);
return read_error($in, "syntax: list closed by $closer: ", $in)
return read_error($in, "syntax: list closed by $closer")
unless $closer eq ')';
return $list;
} elsif ($t eq '\'') {
$t = Read($in);
return read_error($in, "EOF in quote: %s", $in)
return read_error($in, "EOF in quote")
unless defined($t);
return list(intern($Quote), $t);
} elsif ($t eq '#\'') {
$t = Read($in);
return read_error($in, "EOF in quote %s", $in)
return read_error($in, "EOF in quote")
unless defined($t);
return list(intern($n_function), $t);
} elsif ($t eq '.') {
return read_error($in,
"found . where sexpr was expected: %s", $in);
return read_error($in, "found . where sexpr was expected");
} elsif (symbolp($t)) {
return $t;
} elsif ($t =~ m{^\"}) {
......@@ -88,16 +105,13 @@ sub read_list_elems {
push_back_token($t);
return $list;
} elsif ($t eq '.') {
return read_error($in, "syntax: . at start of list: %s",
$in)
return read_error($in, "syntax: . at start of list")
unless $end;
my $sexpr = Read($in);
return undef unless defined($t);
$t = next_token($in);
return
read_error($in,
"syntax: no ) after improper list: %s",
$in)
read_error($in, "no ) after end of improper list")
unless $t eq ')';
rplacd($end, $sexpr);
push_back_token($t);
......@@ -114,7 +128,7 @@ sub read_list_elems {
}
}
}
return read_error($in, "EOF while reading list elements: %s", $in);
return read_error($in, "EOF while reading list elements");
}
......@@ -164,6 +178,7 @@ sub read_string {
my $c;
my $escaped = 0; # numeric, for how many chars
while (defined($c = $in->getc())) {
inc_line() if $c eq "\n";
if ($escaped) {
$escaped--;
$s .= $esc_seq{$c} // $c;
......@@ -194,16 +209,16 @@ sub symbol_or_number_or_dot {
sub error_or_eof {
my ($in) = @_;
if (defined($!)) {
return read_error($in, "read failure line $.: $!: %s", $in);
return read_error($in, "read failure: $!");
}
return read_error($in, "unexpected EOF line $.: %s", $in);
return read_error($in, "unexpected EOF line");
}
sub read_macro {
my ($in) = @_;
#debug("read macro");
my $c = next_nonwhite($in);
return read_error($in, "unexpected EOF line $.: %s", $in)
return read_error($in, "unexpected EOF")
unless defined($c);
if ($c eq '\'') {
my $result = '#\'';
......@@ -211,17 +226,23 @@ sub read_macro {
return $result;
# and possibly more
} else {
return read_error($in, "unknown reader macro \"#$c\": %s", $in);
return read_error($in, "unknown reader macro \"#$c\"");
}
}
sub inc_line {
$linecount++ if $linecount;
}
sub next_nonwhite {
my ($in) = @_;
my $c;
while (defined($c = $in->getc())) {
inc_line() if $c eq "\n";
next if $c =~ /\s/;
if ($c eq ';') { # skip comment
$in->getline();
inc_line();
next;
}
return $c;
......
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