command line options -e -h -l -q -i

Interp.pm

@@ -20,10 +20,39 @@ use Exporter ();
 
 BEGIN {
         @ISA = qw(Exporter);
-        @EXPORT = qw( repl load
+        @EXPORT = qw( repl load eval_string
                     );
 }
 
+sub eval_string {
+        my ($string, $quiet) = @_;
+        return iEval(Read($string), $quiet);
+}
+
+sub iEval {
+        my ($expr, $quiet) = @_;
+        eval_level(0);
+        eval_count(0);
+        cons_count(0);
+
+        my $start = time();
+        my $value = eval { Eval($expr); };
+        my $tdiff = time() - $start;                
+        my $evals = eval_count();
+
+        if (defined($value)) {
+                Lprint($value);
+                terpri();
+        } else {
+                say("Error: $@");
+        }
+        printf(";; %d evals %d pairs in %d ms, %g evals/s\n",
+               $evals, cons_count(), int($tdiff * 1000),
+               $tdiff ? $evals / $tdiff : "NaN")
+            unless $quiet;
+        return $value;
+}
+
 sub repl {
         my ($fh, $interactive) = @_;
 
@@ -31,33 +60,19 @@ sub repl {
         while (1) {
                 if ($interactive) {
                         print("> ");
-                        # this means we are counting conses including those
-                        # needed by Read()
-                        eval_count(0);
-                        cons_count(0);
                 }
                 my $expr = Read($fh);
                 last unless defined($expr);
 
-                eval_level(0);
-                my $start = time();
-                $value = eval { Eval($expr); };
-                my $tdiff = time() - $start;                
-                my $evals = eval_count();
-
-                if (defined($value)) {
-                        if ($interactive) {
-                                Lprint($value);
-                                terpri();
+                if ($interactive) {
+                        $value = iEval($expr);
+                } else {
+                        $value = eval { Eval($expr); };
+                        unless (defined($value)) {
+                                say("Error: $@");
+                                last;
                         }
-                 } else {
-                        say("Error: $@");
-                        last unless $interactive;
                 }
-                printf(";; %d evals %d pairs in %d ms, %g evals/s\n",
-                       $evals, cons_count(), int($tdiff * 1000),
-                       $tdiff ? $evals / $tdiff : "NaN")
-                    if $interactive;
         }
         return $value;
 }

Lis.pl

@@ -12,13 +12,90 @@ use Sexp;
 use Builtin;
 use Interp;
 
-my $loadfile = shift(@ARGV) // '';
+# -e -h -l -q -x
+
+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 @argv_save = @ARGV;
+
+# first run through arguments -- we need these options before evaluating the
+# other ones
+
+ ARGS1:
+    while ($ARGV[0] && $ARGV[0] =~ /^-/) {
+            for (split(//, substr(shift(@ARGV), 1))) {
+                    if (/-/) {
+                            last ARGS1;
+                    } elsif (/e/) {
+                            shift(@ARGV)
+                    } elsif (/h/) {
+                            usage(0);
+                    } elsif (/l/) {
+                            shift(@ARGV)
+                    } elsif (/i/) {
+                            $opt_interactive = 1;
+                    } elsif (/q/) {
+                            $opt_quiet = 1;
+                    } else {
+                            usage(1);
+                    }
+            }
+}
+
+load("Fundamental.lisp", 0, $opt_quiet) or exit(1);
+
+set(intern($ARGS), $Nil);
+@ARGV = @argv_save;
+ ARGS2:
+    while ($ARGV[0] && $ARGV[0] =~ /^-/) {
+            for (split(//, substr(shift(@ARGV), 1))) {
+                    if (/-/) {
+                            last ARGS2;
+                    } elsif (/e/) {
+                            eval_string(shift(@ARGV) || usage(1), $opt_quiet);
+                            $interactive = 0;
+                    } elsif (/h/) {
+                    } elsif (/l/) {
+                            load(shift(@ARGV) || usage(1), 0, $opt_quiet);
+                    } elsif (/i/) {
+                    } elsif (/q/) {
+                    } else {
+                            usage(1);
+                    }
+            }
+}
+
+my $loadfile_arg = shift(@ARGV) // '';
 set(intern($ARGS), array2list(@ARGV));
-load("Fundamental.lisp") or exit(1);
 
-if ($loadfile) {
-        load($loadfile);
-} else {
-        repl(\*STDIN, 1);
+if ($loadfile_arg) {
+        load($loadfile_arg);
+        $interactive = 0;
+}
+
+if ($interactive || $opt_interactive) {
+        repl(\*STDIN, !$opt_quiet);
         print("\n");
 }
+exit(0);
+
+########
+
+sub usage {
+        my ($status) = @_;
+        my $fh = $status ? \*STDERR : \*STDOUT;
+        print $fh (<<EOU);
+usage: Lis.pl [-hq] [-e expression] [-l loadfile] [file] [arg0 ...]
+ -e: evaluate expression
+ -h: show this help text
+ -i: run interactively even with -e or file arguments
+ -l: load file before starting repl
+ -q: be quiet (and non-interactive in general)
+EOU
+        exit($status);
+}
+
+# EOF

TODO

@@ -2,9 +2,11 @@
 
 *: to do; @: in progress; #: blocked; +: done; -: rejected
 
-  * change debug to (format, args, ...) style
+  + command line options like lingo's -e -h -l -q
 
-  * comment out debug calls (they do cost...)
+  + change debug to (format, args, ...) style
+
+  + comment out debug calls (they do cost...)
 
   + idea: have a stack for bound symbols, saved values, and number
     of saved bindings each, to be accessed by something like a