diff --git a/contrib/20.repl/CMakeLists.txt b/contrib/20.repl/CMakeLists.txt new file mode 100644 index 00000000..c0a24065 --- /dev/null +++ b/contrib/20.repl/CMakeLists.txt @@ -0,0 +1 @@ +list(APPEND PICLIB_CONTRIB_LIBS ${PROJECT_SOURCE_DIR}/contrib/20.repl/repl.scm) diff --git a/contrib/20.repl/repl.scm b/contrib/20.repl/repl.scm new file mode 100644 index 00000000..4998fbe4 --- /dev/null +++ b/contrib/20.repl/repl.scm @@ -0,0 +1,52 @@ +(define-library (picrin repl) + (import (scheme base) + (scheme read) + (scheme write) + (scheme eval) + (picrin macro) + (picrin library)) + + ;; FIXME picrin doesn't offer cond-expand for now, so we define a macro ourselves + (define-syntax define-readline + (er-macro-transformer + (lambda (form rename compare) + (if (member '(picrin readline) (libraries)) + `(import (picrin readline) + (picrin readline history)) + `(begin + (define (readline str) + (display str) + (read-line)) + (define (add-history str) + #f)))))) + + (define-readline) + + (define (repl) + (let ((line (readline "> "))) + (if (eof-object? line) + (newline) ; exit + (begin + (add-history line) + (call/cc + (lambda (exit) + (with-exception-handler + (lambda (condition) + (display (error-object-message condition) (current-error-port)) + (newline) + (exit)) + (lambda () + ;; FIXME + ;; non-local exception jump from inside call-with-port + ;; fails with segv, though i don't know why... + (let ((port (open-input-string line))) + (let loop ((expr (read port))) + (unless (eof-object? expr) + (write (eval expr '(picrin user))) + (newline) + (loop (read port)))) + (close-port port)))))) + (repl))))) + + (export repl)) + diff --git a/contrib/30.main/CMakeLists.txt b/contrib/30.main/CMakeLists.txt new file mode 100644 index 00000000..ceef792f --- /dev/null +++ b/contrib/30.main/CMakeLists.txt @@ -0,0 +1 @@ +list(APPEND PICLIB_CONTRIB_LIBS ${PROJECT_SOURCE_DIR}/contrib/30.main/main.scm) diff --git a/contrib/30.main/main.scm b/contrib/30.main/main.scm new file mode 100644 index 00000000..fb075749 --- /dev/null +++ b/contrib/30.main/main.scm @@ -0,0 +1,51 @@ +(define-library (picrin main) + (import (scheme base) + (scheme read) + (scheme write) + (scheme process-context) + (scheme load) + (scheme eval) + (picrin repl)) + + (define (print-help) + (display "picrin scheme\n") + (display "\n") + (display "Usage: picrin [options] [file]\n") + (display "\n") + (display "Options:\n") + (display " -e [program] run one liner script\n") + (display " -h or --help show this help\n")) + + (define (getopt) + (let ((args (cdr (command-line)))) + (if (null? args) + (values 'repl #f) + (case (string->symbol (car args)) + ((-h --help) + (print-help) + (exit 1)) + ((-e) + (values 'line (cadr args))) + (else + (values 'file (car args))))))) + + (define (exec-file filename) + (load filename)) + + (define (exec-line str) + (call-with-port (open-input-string str) + (lambda (in) + (let loop ((expr (read in))) + (unless (eof-object? expr) + (eval expr '(picrin user)) + (loop (read in))))))) + + (define (main) + (call-with-values getopt + (lambda (type dat) + (case type + ((repl) (repl)) + ((line) (exec-line dat)) + ((file) (exec-file dat)))))) + + (export main)) diff --git a/piclib/CMakeLists.txt b/piclib/CMakeLists.txt index 21712355..8f230621 100644 --- a/piclib/CMakeLists.txt +++ b/piclib/CMakeLists.txt @@ -30,5 +30,4 @@ list(APPEND PICLIB_SCHEME_LIBS ${PROJECT_SOURCE_DIR}/piclib/srfi/111.scm ${PROJECT_SOURCE_DIR}/piclib/picrin/user.scm - ${PROJECT_SOURCE_DIR}/piclib/picrin/repl.scm ) diff --git a/piclib/picrin/repl.scm b/piclib/picrin/repl.scm deleted file mode 100644 index 759421d0..00000000 --- a/piclib/picrin/repl.scm +++ /dev/null @@ -1,86 +0,0 @@ -(define-library (picrin repl) - (import (scheme base) - (scheme read) - (scheme file) - (scheme write) - (scheme eval) - (scheme process-context)) - - (define (join sep strs) - (let loop ((result (car strs)) (rest (cdr strs))) - (if (null? rest) - result - (loop (string-append result sep (car rest)) (cdr rest))))) - - (define (file->string file) - (with-input-from-file file - (lambda () - (let loop ((line (read-line)) (acc '())) - (if (eof-object? line) - (join "\n" (reverse acc)) - (loop (read-line) (cons line acc))))))) - - (define (print obj . port) - (let ((port (if (null? port) (current-output-port) (car port)))) - (write obj port) - (newline port) - obj)) - - (define (print-help) - (display "picrin scheme\n") - (display "\n") - (display "Usage: picrin [options] [file]\n") - (display "\n") - (display "Options:\n") - (display " -e [program] run one liner script\n") - (display " -h or --help show this help\n")) - - (define (getopt) - (let ((args (cdr (command-line)))) - (if (null? args) - #f - (case (string->symbol (car args)) - ((-h --help) - (print-help) - (exit 1)) - ((-e) - (cadr args)) - (else - (file->string (car args))))))) - - (define (main-loop in out on-err) - (display "> " out) - (let ((expr (read in))) - (if (eof-object? expr) - (newline out) ; exit - (begin - (call/cc - (lambda (leave) - (with-exception-handler - (lambda (condition) - (display (error-object-message condition) (current-error-port)) - (newline) - (if on-err - (on-err) - (leave))) - (lambda () - (print (eval expr '(picrin user)) out))))) - (main-loop in out on-err))))) - - (define (run-repl program) - (let ((in (if program - (open-input-string program) - (current-input-port))) - (out (if program - (open-output-string) ; ignore output - (current-output-port))) - (on-err (if program - (lambda () (exit 1)) - #f))) - (main-loop in out on-err))) - - (define (repl) - (let ((program (getopt))) - (run-repl program))) - - (export repl)) diff --git a/src/init.c b/src/init.c index 0d345a01..7f869048 100644 --- a/src/init.c +++ b/src/init.c @@ -118,7 +118,8 @@ pic_init_core(pic_state *pic) pic_init_eval(pic); DONE; pic_init_lib(pic); DONE; - pic_load_piclib(pic); DONE; pic_init_contrib(pic); DONE; + + pic_load_piclib(pic); DONE; } } diff --git a/tools/main.c b/tools/main.c index 428b2764..617d4a0d 100644 --- a/tools/main.c +++ b/tools/main.c @@ -14,8 +14,8 @@ main(int argc, char *argv[], char **envp) pic = pic_open(argc, argv, envp); pic_try { - pic_import(pic, pic_read_cstr(pic, "(picrin repl)")); - pic_funcall(pic, "repl", pic_nil_value()); + pic_import(pic, pic_read_cstr(pic, "(picrin main)")); + pic_funcall(pic, "main", pic_nil_value()); } pic_catch { pic_print_backtrace(pic, pic->err);