conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'repl-and-readline'

This commit is contained in:
Yuichi Nishiwaki 2014-08-31 01:47:59 +09:00
parent 82ee8f9171 2a69894bbd
commit 9fefa80466
8 changed files with 109 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
contrib/20.repl/CMakeLists.txt Normal file
View File

@ -0,0 +1 @@
list(APPEND PICLIB_CONTRIB_LIBS ${PROJECT_SOURCE_DIR}/contrib/20.repl/repl.scm)

52
contrib/20.repl/repl.scm Normal file
View File

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

1
contrib/30.main/CMakeLists.txt Normal file
View File

@ -0,0 +1 @@
list(APPEND PICLIB_CONTRIB_LIBS ${PROJECT_SOURCE_DIR}/contrib/30.main/main.scm)

51
contrib/30.main/main.scm Normal file
View File

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

1
piclib/CMakeLists.txt
View File

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

86
piclib/picrin/repl.scm
View File

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

3
src/init.c
View File

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

4
tools/main.c
View File

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