From 029d98338df8d2921e6cd80aea11b2b0bc5a2816 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 31 Aug 2014 00:36:20 +0900
Subject: [PATCH] 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);