Bread (stdin or string); rename readob -> Read; tests 035

Builtin.pm

@@ -20,6 +20,18 @@ use Interp;
 # Builtins get their arguments directly as a Lisp list, have names
 # beginning with 'B', and are defined here (except for, well, exceptions)
 
+sub Bread {
+        my ($arglist) = @_;
+        my ($input) = checkargs($arglist, ':S');
+        if (is_nil($input)) {
+                return Read::Read();
+        } elsif (stringp ($input)) {
+                return Read::Read($input);
+        } else {
+                ...
+        }
+}
+
 sub Brandom {
         my ($arglist) = @_;
         my ($limit) = checkargs($arglist, ':n');
@@ -1034,7 +1046,9 @@ my @builtins =                          # [name, func, is_special, doc]
      ["sqrt", \&Bsqrt, 0, "return the square root of numeric ARG"],
      ["isqrt", \&Bsqrt, 0, "return the integer square root of numeric ARG"],
      ["random", \&Brandom, 0,
-      "return a random number a with 0 <= a < LIMIT (or 1)"]
+      "return a random number a with 0 <= a < LIMIT (or 1)"],
+     ["read", \&Bread, 0,
+      "return an expression read from stdin or &optional INPUT (a string)"],
     );
 
 for my $b (@builtins) {

Interp.pm

@@ -32,11 +32,11 @@ sub repl {
                 if ($interactive) {
                         print("> ");
                         # this means we are counting conses including those
-                        # needed by readob()
+                        # needed by Read()
                         eval_count(0);
                         cons_count(0);
                 }
-                my $expr = readob($fh);
+                my $expr = Read($fh);
                 last unless defined($expr);
 
                 eval_level(0);
@@ -66,7 +66,7 @@ sub load {
         my ($fname, $noerror, $nomessage) = @_;
         my $fh;
 
-        unless (open($fh, '<', $fname)) {
+        unless (open($fh, "<:encoding(UTF-8)", $fname)) {
                 unless ($noerror) {
                         say("cannot open file ($!): %s", $fname);
                         return $Nil;
@@ -74,6 +74,7 @@ sub load {
                 return error("cannot open file ($!) %s", $fname);
         }
         print(";; loading file $fname ... ") unless $nomessage;
+        $| = 1;
         my $result = repl($fh, 0);
         close($fh);
         if (defined($result) && !$nomessage) {

Read.pm

@@ -17,7 +17,7 @@ use Exporter ();
 
 BEGIN {
         @ISA = qw(Exporter);
-        @EXPORT = qw( readob
+        @EXPORT = qw( Read
                    );
 }
 
@@ -25,9 +25,15 @@ my $default_input = \*STDIN;
 
 my $sepchars = quotemeta("();\n");
 
-sub readob {
+sub Read {
         my ($in) = @_;
         $in //= $default_input;
+        if (stringp($in)) {
+                my $string = $in;
+                open(my $str_in, "<", \$string) or
+                    error("read: cannot open string as filehandle: $!\n");
+                $in = $str_in;
+        }
 
         my $t = next_token($in);
         #warn("next token: $t");
@@ -40,11 +46,11 @@ sub readob {
                     unless $closer eq ')';
                 return $list;
         } elsif ($t eq '\'') {
-                $t = readob($in);
+                $t = Read($in);
                 return error("EOF in quote: %s", $in) unless defined($t);
                 return list(intern($Quote), $t);
         } elsif ($t eq '#\'') {
-                $t = readob($in);
+                $t = Read($in);
                 return error("EOF in quote %s", $in) unless defined($t);
                 return list(intern($function), $t);
         } elsif ($t eq '.') {
@@ -53,6 +59,8 @@ sub readob {
                 return $t;
         } elsif ($t =~ m{^\"}) {
                 return substr($t, 1);
+        } elsif ($t eq ')') {
+                return error("close paren unexpected");
         } else {
                 return $t;
         }
@@ -72,7 +80,7 @@ sub read_list_elems {
                         return error("syntax: . at start of list: %s",
                                      $in)
                             unless $end;
-                        my $sexpr = readob($in);
+                        my $sexpr = Read($in);
                         return undef unless defined($t);
                         $t = next_token($in);
                         return error("syntax: no ) after improper list: %s",
@@ -83,7 +91,7 @@ sub read_list_elems {
                         return $list;
                 } else {
                         push_back_token($t);
-                        my $sexpr = readob($in);
+                        my $sexpr = Read($in);
                         return undef unless defined($sexpr);
                         my $newpair = cons($sexpr, $Nil);
                         if ($end) {

tests/035-read.lisp

+(testcmp "read simple" '(cons (read "tangeldadder") nil) "(tangeldadder)")
+(testcmp "read defun" '(progn (eval (read "(defun q (n) (* n n))"))
+                              (q 13)) "169")
+(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")
+
+(testcmp "read error 2" '(or (errset (progn
+                                       (eval (read ")(defun q (n) (* n n))"))
+                                       (q 13)))
+                             (car (split-string *last-error* ": ")))
+         "close paren unexpected")