Commit 1f85867d authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

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

parent da91d47e

Builtin.pm

+15 −1
Original line number Diff line number Diff line
@@ -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

+4 −3
Original line number Diff line number Diff line
@@ -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

+14 −6
Original line number Diff line number Diff line
@@ -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

0 → 100644
+14 −0
Original line number Diff line number Diff line 
(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")