Merge branch 'repl-and-readline'

contrib/20.repl/CMakeLists.txt

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

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

contrib/30.main/CMakeLists.txt

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

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

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
   )

piclib/picrin/repl.scm

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

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

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_import(pic, pic_read_cstr(pic, "(picrin main)"));
-    pic_funcall(pic, "repl", pic_nil_value());
+    pic_funcall(pic, "main", pic_nil_value());
   }
   pic_catch {
     pic_print_backtrace(pic, pic->err);