From 75ae0cad122d0e6483c88395182c63c4c4e8d319 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 30 Aug 2014 23:30:04 +0900 Subject: [PATCH 1/5] repl moves to contrib --- contrib/20.repl/CMakeLists.txt | 1 + {piclib/picrin => contrib/20.repl}/repl.scm | 1 + piclib/CMakeLists.txt | 1 - 3 files changed, 2 insertions(+), 1 deletion(-) create mode 100644 contrib/20.repl/CMakeLists.txt rename {piclib/picrin => contrib/20.repl}/repl.scm (99%) 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/piclib/picrin/repl.scm b/contrib/20.repl/repl.scm similarity index 99% rename from piclib/picrin/repl.scm rename to contrib/20.repl/repl.scm index 759421d0..a0d8f384 100644 --- a/piclib/picrin/repl.scm +++ b/contrib/20.repl/repl.scm @@ -84,3 +84,4 @@ (run-repl program))) (export repl)) + diff --git a/piclib/CMakeLists.txt b/piclib/CMakeLists.txt index 43d5ab4a..6b7a6477 100644 --- a/piclib/CMakeLists.txt +++ b/piclib/CMakeLists.txt @@ -29,5 +29,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 ) From 029d98338df8d2921e6cd80aea11b2b0bc5a2816 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sun, 31 Aug 2014 00:36:20 +0900 Subject: [PATCH 2/5] split repl and main loop --- contrib/20.repl/repl.scm | 81 +++++----------------------------- contrib/30.main/CMakeLists.txt | 1 + contrib/30.main/main.scm | 51 +++++++++++++++++++++ tools/main.c | 4 +- 4 files changed, 64 insertions(+), 73 deletions(-) create mode 100644 contrib/30.main/CMakeLists.txt create mode 100644 contrib/30.main/main.scm diff --git a/contrib/20.repl/repl.scm b/contrib/20.repl/repl.scm index a0d8f384..b8cc93ba 100644 --- a/contrib/20.repl/repl.scm +++ b/contrib/20.repl/repl.scm @@ -1,87 +1,26 @@ (define-library (picrin repl) (import (scheme base) (scheme read) - (scheme file) (scheme write) - (scheme eval) - (scheme process-context)) + (scheme eval)) - (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))) + (define (repl) + (display "> ") + (let ((expr (read))) (if (eof-object? expr) - (newline out) ; exit + (newline) ; exit (begin (call/cc - (lambda (leave) + (lambda (exit) (with-exception-handler (lambda (condition) (display (error-object-message condition) (current-error-port)) (newline) - (if on-err - (on-err) - (leave))) + (exit)) (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))) + (write (eval expr '(picrin user))) + (newline))))) + (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/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); From ac15ac6e2d72b9290e3dae11bd50a190ac975790 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sun, 31 Aug 2014 01:00:13 +0900 Subject: [PATCH 3/5] use readline in repl --- contrib/20.repl/repl.scm | 19 +++++++++++++------ src/init.c | 3 ++- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/contrib/20.repl/repl.scm b/contrib/20.repl/repl.scm index b8cc93ba..010212ac 100644 --- a/contrib/20.repl/repl.scm +++ b/contrib/20.repl/repl.scm @@ -2,14 +2,16 @@ (import (scheme base) (scheme read) (scheme write) - (scheme eval)) + (scheme eval) + (picrin readline) + (picrin readline history)) (define (repl) - (display "> ") - (let ((expr (read))) - (if (eof-object? expr) + (let ((line (readline "> "))) + (if (eof-object? line) (newline) ; exit (begin + (add-history line) (call/cc (lambda (exit) (with-exception-handler @@ -18,8 +20,13 @@ (newline) (exit)) (lambda () - (write (eval expr '(picrin user))) - (newline))))) + (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/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; } } From 96a90810afdb6c4d642ec522cabb3e369a4b0919 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sun, 31 Aug 2014 01:41:12 +0900 Subject: [PATCH 4/5] import (picrin readline) only when exists --- contrib/20.repl/repl.scm | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/contrib/20.repl/repl.scm b/contrib/20.repl/repl.scm index 010212ac..d2064c8f 100644 --- a/contrib/20.repl/repl.scm +++ b/contrib/20.repl/repl.scm @@ -3,8 +3,23 @@ (scheme read) (scheme write) (scheme eval) - (picrin readline) - (picrin readline history)) + (picrin macro) + (picrin library)) + + (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 "> "))) From 2a69894bbd79ec530c7a52e39ca74233be0046b6 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sun, 31 Aug 2014 01:41:37 +0900 Subject: [PATCH 5/5] add commentary for future work --- contrib/20.repl/repl.scm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/contrib/20.repl/repl.scm b/contrib/20.repl/repl.scm index d2064c8f..4998fbe4 100644 --- a/contrib/20.repl/repl.scm +++ b/contrib/20.repl/repl.scm @@ -6,6 +6,7 @@ (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) @@ -35,6 +36,9 @@ (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)