SRFI-22 now requires the -r (run) option.

benchmarks/shootout/binarytrees.chibi

@@ -26,21 +26,21 @@
 
 (define (print . args) (for-each display args) (newline))
 
-(define (main args)
+(let* ((args (command-line))
-  (let* ((n (string->number (cadr args)))
+       (n (string->number (cadr args)))
-         (min-depth 4)
+       (min-depth 4)
-         (max-depth (max (+ min-depth 2) n))
+       (max-depth (max (+ min-depth 2) n))
-         (stretch-depth (+ max-depth 1)))
+       (stretch-depth (+ max-depth 1)))
-    (print "stretch tree of depth " stretch-depth "\t check: "
+  (print "stretch tree of depth " stretch-depth "\t check: "
-           (check (make 0 stretch-depth)))
+         (check (make 0 stretch-depth)))
-    (let ((long-lived-tree (make 0 max-depth)))
+  (let ((long-lived-tree (make 0 max-depth)))
-      (do ((d min-depth (+ d 2)))
+    (do ((d min-depth (+ d 2)))
-          ((>= d max-depth))
+        ((>= d max-depth))
-        (let ((iterations (* 2 (+ (- max-depth d) min-depth))))
+      (let ((iterations (* 2 (+ (- max-depth d) min-depth))))
-          (print (* 2 iterations) "\t trees of depth " d "\t check: "
+        (print (* 2 iterations) "\t trees of depth " d "\t check: "
-                 (do ((i 0 (+ i 1))
+               (do ((i 0 (+ i 1))
-                      (c 0 (+ c (check (make i d)) (check (make (- i) d)))))
+                    (c 0 (+ c (check (make i d)) (check (make (- i) d)))))
-                     ((>= i iterations)
+                   ((>= i iterations)
-                      c)))))
+                    c)))))
-      (print "long lived tree of depth " max-depth "\t check: "
+    (print "long lived tree of depth " max-depth "\t check: "
-             (check long-lived-tree)))))
+           (check long-lived-tree))))

doc/chibi-scheme.1

@@ -6,7 +6,7 @@ chibi-scheme \- a tiny Scheme interpreter
 
 .SH SYNOPSIS
 .B chibi-scheme
-[-qfV]
+[-qrfV]
 [-I
 .I path
 ]
@@ -86,6 +86,9 @@ Don't load the initialization file.  The resulting
 environment will only contain the core syntactic forms
 and primitives coded in C.
 .TP
+.BI -r
+Run the "main" procedure when the script finishes loading as in SRFI-22.
+.TP
 .BI -f
 Change the reader to case-fold symbols as in R5RS.
 .TP

main.c

@@ -314,7 +314,7 @@ void run_main (int argc, char **argv) {
   char *impmod, *p;
   sexp_sint_t len;
 #endif
-  char *arg, *prefix=NULL, *suffix=NULL;
+  char *arg, *prefix=NULL, *suffix=NULL, *main_symbol=NULL;
   sexp_sint_t i, j, c, quit=0, print=0, init_loaded=0, mods_loaded=0,
     fold_case=SEXP_DEFAULT_FOLD_CASE_SYMS;
   sexp_uint_t heap_size=0, heap_max_size=SEXP_MAXIMUM_HEAP_SIZE;
@@ -451,6 +451,9 @@ void run_main (int argc, char **argv) {
       if (ctx) sexp_global(ctx, SEXP_G_FOLD_CASE_P) = SEXP_TRUE;
       break;
 #endif
+    case 'r':
+      main_symbol = argv[i][2] == '\0' ? "main" : argv[i]+2;
+      break;
     default:
       fprintf(stderr, "unknown option: %s\n", argv[i]);
       sexp_usage(1);
@@ -492,11 +495,13 @@ void run_main (int argc, char **argv) {
       sexp_warn_undefs(ctx, env, tmp, SEXP_VOID);
 #endif
       /* SRFI-22: run main if specified */
-      sym = sexp_intern(ctx, "main", -1);
+      if (main_symbol) {
-      tmp = sexp_env_ref(env, sym, SEXP_FALSE);
+        sym = sexp_intern(ctx, main_symbol, -1);
-      if (sexp_procedurep(tmp)) {
+        tmp = sexp_env_ref(env, sym, SEXP_FALSE);
-        args = sexp_list1(ctx, args);
+        if (sexp_procedurep(tmp)) {
-        check_exception(ctx, sexp_apply(ctx, tmp, args));
+          args = sexp_list1(ctx, args);
+          check_exception(ctx, sexp_apply(ctx, tmp, args));
+        }
       }
     } else {
       repl(ctx, env);

tools/chibi-doc

@@ -666,7 +666,7 @@ div#footer {padding-bottom: 50px}
        ,@(reverse (append-map (lambda (x) (extract-docs x defs exports 'ffi))
                               (module-shared-includes mod)))))))
 
-(define (main args)
+(let ((args (command-line)))
   (case (length args)
     ((0 1)
      (convert (current-input-port)))

tools/chibi-ffi

@@ -1639,7 +1639,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; main
 
-(define (main args)
+(let ((args (command-line)))
   (if (not (null? args)) (set! args (cdr args)))
   (let* ((compile? (and (pair? args) (member (car args) '("-c" "--compile"))))
          (args (if compile? (cdr args) args))

tools/chibi-genstatic

@@ -209,17 +209,17 @@
   (display (init-name (cdr lib)))
   (display " },\n"))
 
-(define (main args)
+(let* ((args (command-line))
-  (let ((c-libs (find-c-libs (if (pair? args) (cdr args) args))))
+       (c-libs (find-c-libs (if (pair? args) (cdr args) args))))
-    (newline)
+  (newline)
-    (for-each include-c-lib c-libs)
+  (for-each include-c-lib c-libs)
-    (newline)
+  (newline)
-    ;; (display "typedef struct {\n")
+  ;; (display "typedef struct {\n")
-    ;; (display "  const char *name;\n")
+  ;; (display "  const char *name;\n")
-    ;; (display "  sexp_init_proc init;\n")
+  ;; (display "  sexp_init_proc init;\n")
-    ;; (display "} sexp_library_entry_t;\n")
+  ;; (display "} sexp_library_entry_t;\n")
-    ;; (newline)
+  ;; (newline)
-    (display "struct sexp_library_entry_t sexp_static_libraries[] = {\n")
+  (display "struct sexp_library_entry_t sexp_static_libraries[] = {\n")
-    (for-each init-c-lib c-libs)
+  (for-each init-c-lib c-libs)
-    (display "  { NULL, NULL }\n")
+  (display "  { NULL, NULL }\n")
-    (display "};\n\n")))
+  (display "};\n\n"))

tools/extract-case-offsets.scm

@@ -96,7 +96,7 @@
                          (lambda () (make-iset))))))))))
             (lp))))))))
 
-(define (main args)
+(let ((args (command-line)))
   (let lp ((ls (cdr args))
            (min-count 26)
            (max-char-sets #f)

tools/extract-unicode-props.scm

@@ -178,7 +178,7 @@
     "Whitespace=Zs,Zl,Zp,0009,000A,000B,000C,000D"
     "Digit=Nd"))
 
-(define (main args)
+(let ((args (command-line)))
   (let lp ((ls (cdr args))
            (data "data/UnicodeData.txt")
            (derived "data/DerivedCoreProperties.txt")

tools/optimize-char-sets.scm

@@ -20,7 +20,7 @@
     (for-each (lambda (i) (hash-table-set! ls2-tab i #t)) ls2)
     (remove (lambda (i) (hash-table-exists? ls2-tab i)) ls1)))
 
-(define (main args)
+(let ((args (command-line)))
   (let lp ((ls (cdr args)) (ascii? #f))
     (cond
      ((and (pair? ls) (not (equal? "" (car ls)))