Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
Alex Shinn 2012-11-11 16:17:26 +09:00
parent 28460d3664
commit 3373469883
9 changed files with 52 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
benchmarks/shootout/binarytrees.chibi
View file

@ -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))))

5
doc/chibi-scheme.1
View file

@ -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

17
main.c
View file

@ -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);

2
tools/chibi-doc
View file

@ -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)))

2
tools/chibi-ffi
View file

@ -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))

28
tools/chibi-genstatic
View file

@ -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"))

2
tools/extract-case-offsets.scm
View file

@ -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)

2
tools/extract-unicode-props.scm
View file

@ -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")

2
tools/optimize-char-sets.scm
View file

@ -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)))