diff --git a/benchmarks/shootout/binarytrees.chibi b/benchmarks/shootout/binarytrees.chibi index d6dfad98..c0d6b637 100755 --- a/benchmarks/shootout/binarytrees.chibi +++ b/benchmarks/shootout/binarytrees.chibi @@ -26,21 +26,21 @@ (define (print . args) (for-each display args) (newline)) -(define (main args) - (let* ((n (string->number (cadr args))) - (min-depth 4) - (max-depth (max (+ min-depth 2) n)) - (stretch-depth (+ max-depth 1))) - (print "stretch tree of depth " stretch-depth "\t check: " - (check (make 0 stretch-depth))) - (let ((long-lived-tree (make 0 max-depth))) - (do ((d min-depth (+ d 2))) - ((>= d max-depth)) - (let ((iterations (* 2 (+ (- max-depth d) min-depth)))) - (print (* 2 iterations) "\t trees of depth " d "\t check: " - (do ((i 0 (+ i 1)) - (c 0 (+ c (check (make i d)) (check (make (- i) d))))) - ((>= i iterations) - c))))) - (print "long lived tree of depth " max-depth "\t check: " - (check long-lived-tree))))) +(let* ((args (command-line)) + (n (string->number (cadr args))) + (min-depth 4) + (max-depth (max (+ min-depth 2) n)) + (stretch-depth (+ max-depth 1))) + (print "stretch tree of depth " stretch-depth "\t check: " + (check (make 0 stretch-depth))) + (let ((long-lived-tree (make 0 max-depth))) + (do ((d min-depth (+ d 2))) + ((>= d max-depth)) + (let ((iterations (* 2 (+ (- max-depth d) min-depth)))) + (print (* 2 iterations) "\t trees of depth " d "\t check: " + (do ((i 0 (+ i 1)) + (c 0 (+ c (check (make i d)) (check (make (- i) d))))) + ((>= i iterations) + c))))) + (print "long lived tree of depth " max-depth "\t check: " + (check long-lived-tree)))) diff --git a/doc/chibi-scheme.1 b/doc/chibi-scheme.1 index da879cfb..ce148dca 100644 --- a/doc/chibi-scheme.1 +++ b/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 diff --git a/main.c b/main.c index 6c3cf93f..169ecabe 100644 --- a/main.c +++ b/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); - tmp = sexp_env_ref(env, sym, SEXP_FALSE); - if (sexp_procedurep(tmp)) { - args = sexp_list1(ctx, args); - check_exception(ctx, sexp_apply(ctx, tmp, args)); + if (main_symbol) { + sym = sexp_intern(ctx, main_symbol, -1); + tmp = sexp_env_ref(env, sym, SEXP_FALSE); + if (sexp_procedurep(tmp)) { + args = sexp_list1(ctx, args); + check_exception(ctx, sexp_apply(ctx, tmp, args)); + } } } else { repl(ctx, env); diff --git a/tools/chibi-doc b/tools/chibi-doc index 30ef0e9c..31acd21b 100755 --- a/tools/chibi-doc +++ b/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))) diff --git a/tools/chibi-ffi b/tools/chibi-ffi index 7ba7f2bb..abbacd48 100755 --- a/tools/chibi-ffi +++ b/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)) diff --git a/tools/chibi-genstatic b/tools/chibi-genstatic index 18946bdd..c786ed8c 100755 --- a/tools/chibi-genstatic +++ b/tools/chibi-genstatic @@ -209,17 +209,17 @@ (display (init-name (cdr lib))) (display " },\n")) -(define (main args) - (let ((c-libs (find-c-libs (if (pair? args) (cdr args) args)))) - (newline) - (for-each include-c-lib c-libs) - (newline) - ;; (display "typedef struct {\n") - ;; (display " const char *name;\n") - ;; (display " sexp_init_proc init;\n") - ;; (display "} sexp_library_entry_t;\n") - ;; (newline) - (display "struct sexp_library_entry_t sexp_static_libraries[] = {\n") - (for-each init-c-lib c-libs) - (display " { NULL, NULL }\n") - (display "};\n\n"))) +(let* ((args (command-line)) + (c-libs (find-c-libs (if (pair? args) (cdr args) args)))) + (newline) + (for-each include-c-lib c-libs) + (newline) + ;; (display "typedef struct {\n") + ;; (display " const char *name;\n") + ;; (display " sexp_init_proc init;\n") + ;; (display "} sexp_library_entry_t;\n") + ;; (newline) + (display "struct sexp_library_entry_t sexp_static_libraries[] = {\n") + (for-each init-c-lib c-libs) + (display " { NULL, NULL }\n") + (display "};\n\n")) diff --git a/tools/extract-case-offsets.scm b/tools/extract-case-offsets.scm index 776f6951..cf4bee6e 100644 --- a/tools/extract-case-offsets.scm +++ b/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) diff --git a/tools/extract-unicode-props.scm b/tools/extract-unicode-props.scm index ee55578d..49d0922c 100755 --- a/tools/extract-unicode-props.scm +++ b/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") diff --git a/tools/optimize-char-sets.scm b/tools/optimize-char-sets.scm index 37aeb026..db9f0214 100644 --- a/tools/optimize-char-sets.scm +++ b/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)))