From 94296d8dcfb46812bb142e4fb6a41e9bc810d287 Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Mon, 20 Jul 2020 18:57:35 +0100
Subject: files moved from original import locations

---
 elisp/geiser-chez.el         | 158 -------------------------------------------
 geiser-chez.el               | 158 +++++++++++++++++++++++++++++++++++++++++++
 scheme/chez/geiser/geiser.ss | 155 ------------------------------------------
 scheme/chez/geiser/test.ss   | 120 --------------------------------
 src/geiser/geiser.ss         | 155 ++++++++++++++++++++++++++++++++++++++++++
 src/geiser/test.ss           | 120 ++++++++++++++++++++++++++++++++
 6 files changed, 433 insertions(+), 433 deletions(-)
 delete mode 100644 elisp/geiser-chez.el
 create mode 100644 geiser-chez.el
 delete mode 100644 scheme/chez/geiser/geiser.ss
 delete mode 100644 scheme/chez/geiser/test.ss
 create mode 100644 src/geiser/geiser.ss
 create mode 100644 src/geiser/test.ss

diff --git a/elisp/geiser-chez.el b/elisp/geiser-chez.el
deleted file mode 100644
index 3d4b495..0000000
--- a/elisp/geiser-chez.el
+++ /dev/null
@@ -1,158 +0,0 @@
-;;; geiser-chez.el -- Chez Scheme's implementation of the geiser protocols
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the Modified BSD License. You should
-;; have received a copy of the license along with this program. If
-;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-
-
-;;; Code:
-
-(require 'geiser-connection)
-(require 'geiser-syntax)
-(require 'geiser-custom)
-(require 'geiser-base)
-(require 'geiser-eval)
-(require 'geiser-edit)
-(require 'geiser-log)
-(require 'geiser)
-
-(require 'compile)
-(require 'info-look)
-
-(eval-when-compile (require 'cl-lib))
-
-
-;;; Customization:
-
-(defgroup geiser-chez nil
-  "Customization for Geiser's Chez Scheme flavour."
-  :group 'geiser)
-
-(geiser-custom--defcustom geiser-chez-binary
-    "scheme"
-  "Name to use to call the Chez Scheme executable when starting a REPL."
-  :type '(choice string (repeat string))
-  :group 'geiser-chez)
-
-(geiser-custom--defcustom geiser-chez-init-file "~/.chez-geiser"
-  "Initialization file with user code for the Chez REPL."
-  :type 'string
-  :group 'geiser-chez)
-
-(geiser-custom--defcustom geiser-chez-extra-command-line-parameters '()
-  "Additional parameters to supply to the Chez binary."
-  :type '(repeat string)
-  :group 'geiser-chez)
-
-
-;;; REPL support:
-
-(defun geiser-chez--binary ()
-  (if (listp geiser-chez-binary)
-      (car geiser-chez-binary)
-    geiser-chez-binary))
-
-(defun geiser-chez--parameters ()
-  "Return a list with all parameters needed to start Chez Scheme.
-This function uses `geiser-chez-init-file' if it exists."
-  (let ((init-file (and (stringp geiser-chez-init-file)
-                        (expand-file-name geiser-chez-init-file))))
-    `(,@(and init-file (file-readable-p init-file) (list init-file))
-      ,(expand-file-name "chez/geiser/geiser.ss" geiser-scheme-dir)
-      ,@geiser-chez-extra-command-line-parameters)))
-
-(defconst geiser-chez--prompt-regexp "> ")
-
-
-;;; Evaluation support:
-
-(defun geiser-chez--geiser-procedure (proc &rest args)
-  (cl-case proc
-    ((eval compile)
-     (let ((form (mapconcat 'identity (cdr args) " "))
-           (module (cond ((string-equal "'()" (car args))
-                          "'()")
-                         ((and (car args))
-                          (concat "'" (car args)))
-                         (t
-                          "#f"))))
-       (format "(geiser:eval %s '%s)" module form)))
-    ((load-file compile-file)
-     (format "(geiser:load-file %s)" (car args)))
-    ((no-values)
-     "(geiser:no-values)")
-    (t
-     (let ((form (mapconcat 'identity args " ")))
-       (format "(geiser:%s %s)" proc form)))))
-
-(defun geiser-chez--get-module (&optional module)
-  (cond ((null module)
-         :f)
-        ((listp module) module)
-        ((stringp module)
-         (condition-case nil
-             (car (geiser-syntax--read-from-string module))
-           (error :f)))
-        (t :f)))
-
-(defun geiser-chez--symbol-begin (module)
-  (if module
-      (max (save-excursion (beginning-of-line) (point))
-           (save-excursion (skip-syntax-backward "^(>") (1- (point))))
-    (save-excursion (skip-syntax-backward "^'-()>") (point))))
-
-(defun geiser-chez--import-command (module)
-  (format "(import %s)" module))
-
-(defun geiser-chez--exit-command () "(exit 0)")
-;; 
-;; ;;; REPL startup
-
-(defconst geiser-chez-minimum-version "9.4")
-
-(defun geiser-chez--version (binary)
-  (car (process-lines binary "--version")))
-
-(defun geiser-chez--startup (remote)
-  (let ((geiser-log-verbose-p t))
-    (compilation-setup t)
-    (geiser-eval--send/wait "(begin (import (geiser)) (write `((result ) (output . \"\"))) (newline))")))
-
-(defun geiser-chez--display-error (module key msg)
-  (when (stringp msg)
-    (save-excursion (insert msg))
-    (geiser-edit--buttonize-files))
-  (and (or (eq key 'chez-error-message)
-           (not key))
-       (not (zerop (length msg)))
-       msg))
-
-;;; Implementation definition:
-
-(define-geiser-implementation chez
-  (binary geiser-chez--binary)
-  (arglist geiser-chez--parameters)
-  (version-command geiser-chez--version)
-  (minimum-version geiser-chez-minimum-version)
-  (repl-startup geiser-chez--startup)
-  (prompt-regexp geiser-chez--prompt-regexp)
-  (debugger-prompt-regexp nil) ;; geiser-chez--debugger-prompt-regexp
-  ;; (enter-debugger geiser-chez--enter-debugger)
-  (marshall-procedure geiser-chez--geiser-procedure)
-  (find-module geiser-chez--get-module)
-  ;; (enter-command geiser-chez--enter-command)
-  (exit-command geiser-chez--exit-command)
-  (import-command geiser-chez--import-command)
-  (find-symbol-begin geiser-chez--symbol-begin)
-  (display-error geiser-chez--display-error)
-  ;; (external-help geiser-chez--manual-look-up)
-  ;; (check-buffer geiser-chez--guess)
-  ;; (keywords geiser-chez--keywords)
-  ;; (case-sensitive geiser-chez-case-sensitive-p)
-  )
-
-(geiser-impl--add-to-alist 'regexp "\\.ss$" 'chez t)
-(geiser-impl--add-to-alist 'regexp "\\.def$" 'chez t)
-
-(provide 'geiser-chez)
diff --git a/geiser-chez.el b/geiser-chez.el
new file mode 100644
index 0000000..3d4b495
--- /dev/null
+++ b/geiser-chez.el
@@ -0,0 +1,158 @@
+;;; geiser-chez.el -- Chez Scheme's implementation of the geiser protocols
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+
+;;; Code:
+
+(require 'geiser-connection)
+(require 'geiser-syntax)
+(require 'geiser-custom)
+(require 'geiser-base)
+(require 'geiser-eval)
+(require 'geiser-edit)
+(require 'geiser-log)
+(require 'geiser)
+
+(require 'compile)
+(require 'info-look)
+
+(eval-when-compile (require 'cl-lib))
+
+
+;;; Customization:
+
+(defgroup geiser-chez nil
+  "Customization for Geiser's Chez Scheme flavour."
+  :group 'geiser)
+
+(geiser-custom--defcustom geiser-chez-binary
+    "scheme"
+  "Name to use to call the Chez Scheme executable when starting a REPL."
+  :type '(choice string (repeat string))
+  :group 'geiser-chez)
+
+(geiser-custom--defcustom geiser-chez-init-file "~/.chez-geiser"
+  "Initialization file with user code for the Chez REPL."
+  :type 'string
+  :group 'geiser-chez)
+
+(geiser-custom--defcustom geiser-chez-extra-command-line-parameters '()
+  "Additional parameters to supply to the Chez binary."
+  :type '(repeat string)
+  :group 'geiser-chez)
+
+
+;;; REPL support:
+
+(defun geiser-chez--binary ()
+  (if (listp geiser-chez-binary)
+      (car geiser-chez-binary)
+    geiser-chez-binary))
+
+(defun geiser-chez--parameters ()
+  "Return a list with all parameters needed to start Chez Scheme.
+This function uses `geiser-chez-init-file' if it exists."
+  (let ((init-file (and (stringp geiser-chez-init-file)
+                        (expand-file-name geiser-chez-init-file))))
+    `(,@(and init-file (file-readable-p init-file) (list init-file))
+      ,(expand-file-name "chez/geiser/geiser.ss" geiser-scheme-dir)
+      ,@geiser-chez-extra-command-line-parameters)))
+
+(defconst geiser-chez--prompt-regexp "> ")
+
+
+;;; Evaluation support:
+
+(defun geiser-chez--geiser-procedure (proc &rest args)
+  (cl-case proc
+    ((eval compile)
+     (let ((form (mapconcat 'identity (cdr args) " "))
+           (module (cond ((string-equal "'()" (car args))
+                          "'()")
+                         ((and (car args))
+                          (concat "'" (car args)))
+                         (t
+                          "#f"))))
+       (format "(geiser:eval %s '%s)" module form)))
+    ((load-file compile-file)
+     (format "(geiser:load-file %s)" (car args)))
+    ((no-values)
+     "(geiser:no-values)")
+    (t
+     (let ((form (mapconcat 'identity args " ")))
+       (format "(geiser:%s %s)" proc form)))))
+
+(defun geiser-chez--get-module (&optional module)
+  (cond ((null module)
+         :f)
+        ((listp module) module)
+        ((stringp module)
+         (condition-case nil
+             (car (geiser-syntax--read-from-string module))
+           (error :f)))
+        (t :f)))
+
+(defun geiser-chez--symbol-begin (module)
+  (if module
+      (max (save-excursion (beginning-of-line) (point))
+           (save-excursion (skip-syntax-backward "^(>") (1- (point))))
+    (save-excursion (skip-syntax-backward "^'-()>") (point))))
+
+(defun geiser-chez--import-command (module)
+  (format "(import %s)" module))
+
+(defun geiser-chez--exit-command () "(exit 0)")
+;; 
+;; ;;; REPL startup
+
+(defconst geiser-chez-minimum-version "9.4")
+
+(defun geiser-chez--version (binary)
+  (car (process-lines binary "--version")))
+
+(defun geiser-chez--startup (remote)
+  (let ((geiser-log-verbose-p t))
+    (compilation-setup t)
+    (geiser-eval--send/wait "(begin (import (geiser)) (write `((result ) (output . \"\"))) (newline))")))
+
+(defun geiser-chez--display-error (module key msg)
+  (when (stringp msg)
+    (save-excursion (insert msg))
+    (geiser-edit--buttonize-files))
+  (and (or (eq key 'chez-error-message)
+           (not key))
+       (not (zerop (length msg)))
+       msg))
+
+;;; Implementation definition:
+
+(define-geiser-implementation chez
+  (binary geiser-chez--binary)
+  (arglist geiser-chez--parameters)
+  (version-command geiser-chez--version)
+  (minimum-version geiser-chez-minimum-version)
+  (repl-startup geiser-chez--startup)
+  (prompt-regexp geiser-chez--prompt-regexp)
+  (debugger-prompt-regexp nil) ;; geiser-chez--debugger-prompt-regexp
+  ;; (enter-debugger geiser-chez--enter-debugger)
+  (marshall-procedure geiser-chez--geiser-procedure)
+  (find-module geiser-chez--get-module)
+  ;; (enter-command geiser-chez--enter-command)
+  (exit-command geiser-chez--exit-command)
+  (import-command geiser-chez--import-command)
+  (find-symbol-begin geiser-chez--symbol-begin)
+  (display-error geiser-chez--display-error)
+  ;; (external-help geiser-chez--manual-look-up)
+  ;; (check-buffer geiser-chez--guess)
+  ;; (keywords geiser-chez--keywords)
+  ;; (case-sensitive geiser-chez-case-sensitive-p)
+  )
+
+(geiser-impl--add-to-alist 'regexp "\\.ss$" 'chez t)
+(geiser-impl--add-to-alist 'regexp "\\.def$" 'chez t)
+
+(provide 'geiser-chez)
diff --git a/scheme/chez/geiser/geiser.ss b/scheme/chez/geiser/geiser.ss
deleted file mode 100644
index 33d1b39..0000000
--- a/scheme/chez/geiser/geiser.ss
+++ /dev/null
@@ -1,155 +0,0 @@
-(library (geiser)
-  (export geiser:eval
-          geiser:completions
-          geiser:module-completions
-          geiser:autodoc
-          geiser:no-values
-          geiser:load-file
-          geiser:newline
-          geiser:macroexpand)
-  (import (chezscheme))
-
-  (define (last-index-of str-list char idx last-idx)
-    (if (null? str-list)
-        last-idx
-        (last-index-of (cdr str-list) char (+ 1 idx) (if (char=? char (car str-list)) idx last-idx))))
-
-  (define (obj-file-name name)
-    (let ((idx (last-index-of (string->list name) #\. 0 -1)))
-      (if (= idx -1)
-          (string-append name ".so")
-          (string-append (substring name 0 idx) ".so"))))
-
-  (define (geiser:load-file filename)
-    (let ((output-filename (obj-file-name filename)))
-      (maybe-compile-file filename output-filename)
-      (load output-filename)))
-
-  (define string-prefix?
-    (lambda (x y)
-      (let ([n (string-length x)])
-        (and (fx<= n (string-length y))
-             (let prefix? ([i 0])
-               (or (fx= i n)
-                   (and (char=? (string-ref x i) (string-ref y i))
-                        (prefix? (fx+ i 1)))))))))
-
-  (define (geiser:completions prefix . rest)
-    rest
-    (sort string-ci<?
-          (filter (lambda (el)
-                    (string-prefix? prefix el))
-                  (map write-to-string (environment-symbols (interaction-environment))))))
-
-  (define (write-to-string x)
-    (with-output-to-string
-      (lambda ()
-        (write x))))
-
-  (define (geiser:eval module form . rest)
-    rest
-    (let ((output-string (open-output-string)))
-      (write
-       (call/cc
-        (lambda (k)
-          (with-exception-handler
-              (lambda (e)
-                (k `((result "")
-                     (output . ,(with-output-to-string
-                                  (lambda ()
-                                    (display-condition e))))
-                     (error (key . chez-error-message)))))
-            (lambda ()
-              (call-with-values
-                  ;; evaluate form, allow for multiple return values,
-                  ;; and capture output in output-string.
-                  (lambda ()
-                    (parameterize ((current-output-port output-string))
-                      (if module
-                          (eval form (environment module))
-                          (eval form))))
-                (lambda result
-                  `((result ,(with-output-to-string
-                               (lambda ()
-                                 (pretty-print
-                                  (if (null? (cdr result)) (car result) result)))))
-                    (output . ,(get-output-string output-string))))))))))
-      (newline)
-      (close-output-port output-string)))
-
-  (define (geiser:module-completions prefix . rest)
-    (define (substring? s1 s2)
-      (let ([n1 (string-length s1)] [n2 (string-length s2)])
-        (let loop2 ([i2 0])
-          (let loop1 ([i1 0] [j i2])
-            (if (fx= i1 n1)
-                i2
-                (and (not (fx= j n2))
-                     (if (char=? (string-ref s1 i1) (string-ref s2 j))
-                         (loop1 (fx+ i1 1) (fx+ j 1))
-                         (loop2 (fx+ i2 1)))))))))
-    (filter (lambda (el)
-              (substring? prefix el))
-            (map write-to-string (library-list))))
-
-  (define (procedure-parameter-list p)
-    ;; same as (inspect object), then hitting c
-    (let ((s (((inspect/object p) 'code) 'source)))
-      (if s
-          (let ((form (s 'value)))
-            (if (and (list? form)
-                     (> (length form) 2)
-                     (eq? (car form) 'lambda))
-                (cadr form)
-                #f))
-          #f)))
-
-  (define (operator-arglist operator)
-    (let ((binding (eval operator)))
-      (if binding
-          (let ((arglist (procedure-parameter-list binding)))
-            (let loop ((arglist arglist)
-                       (optionals? #f)
-                       (required '())
-                       (optional '()))
-              (cond ((null? arglist)
-                     `(,operator ("args" (("required" ,@(reverse required))
-                                          ("optional" ,@(reverse optional))
-                                          ("key")
-                                          ;; ("module" ,module)
-                                          ))))
-                    ((symbol? arglist)
-                     (loop '()
-                           #t
-                           required
-                           (cons "..." (cons arglist optional))))
-                    (else
-                     (loop
-                      (cdr arglist)
-                      optionals?
-                      (if optionals? required (cons (car arglist) required))
-                      (if optionals? (cons (car arglist) optional) optional))))))
-          '())))
-
-  (define (geiser:autodoc ids . rest)
-    (cond ((null? ids) '())
-          ((not (list? ids))
-           (geiser:autodoc (list ids)))
-          ((not (symbol? (car ids)))
-           (geiser:autodoc (cdr ids)))
-          (else
-           (map (lambda (id)
-                  (operator-arglist id))
-                ids))))
-
-  (define (geiser:no-values)
-    #f)
-
-  (define (geiser:newline)
-    #f)
-
-  (define (geiser:macroexpand form . rest)
-    (with-output-to-string
-      (lambda ()
-        (pretty-print
-         (syntax->datum (expand form)))))))
diff --git a/scheme/chez/geiser/test.ss b/scheme/chez/geiser/test.ss
deleted file mode 100644
index 2407448..0000000
--- a/scheme/chez/geiser/test.ss
+++ /dev/null
@@ -1,120 +0,0 @@
-(import (geiser)
-        (chezscheme))
-
-(define-syntax assert-equal
-  (syntax-rules ()
-    ((_ a b)
-     (if (equal? a b)
-         #t
-         (begin
-           (display (format "failed assertion `~a' == `~a'" a b))
-           (assert (equal? a b)))))))
-
-(define-syntax get-result
-  (syntax-rules ()
-    ((_ form)
-     (with-output-to-string
-       (lambda ()
-         (geiser:eval #f form))))))
-
-(define-syntax do-test
-  (syntax-rules ()
-    ((_ form result)
-     (assert
-      (equal?
-       (get-result form)
-       result)))))
-
-(define-syntax do-test-macroexpand
-  (syntax-rules ()
-    ((_ form result)
-     (assert
-      (equal? (geiser:macroexpand form)
-              result)))))
-
-(define-syntax test-or
-  (syntax-rules ()
-    ((_ x) x)
-    ((_ x xs ...)
-     (if x
-         x
-         (test-or xs ...)))))
-
-(do-test-macroexpand
- '(test-or 1)
- '1)
-
-(do-test-macroexpand
- '(test-or 1 2)
- '(if 1 1 2))
-
-;; (something-doesnot-exist)
-;;=> Error: Exception: variable something-doesnot-exist is not bound
-(do-test
- '(something-doesnot-exist)
- "((result \"\") (output . \"\") (error (key . \"Exception: variable something-doesnot-exist is not bound\")))\n"
- )
-
-;; (make-violation)
-;;=> #<condition &violation>
-(do-test
- '(make-violation)
- "((result \"#<condition &violation>\\n\") (output . \"\"))\n")
-
-;; (values 1 2 3)
-;;==> (1 2 3)
-(do-test
- '(values 1 2 3)
- "((result \"(1 2 3)\\n\") (output . \"\"))\n")
-
-;; 1
-;;=> 1
-(do-test '1 "((result \"1\\n\") (output . \"\"))\n")
-
-
-;; '(case-lambda
-;;    [(x1 x2) (+ x1 x2)]
-;;    [(x1 x2 x3) (+ (+ x1 x2) x3)]
-;;    [(x1 x2 . rest)
-;;     ((letrec ([loop (lambda (x1 x2 rest)
-;;                    (let ([x (+ x1 x2)])
-;;                      (if (null? rest)
-;;                          x
-;;                          (loop x (car rest) (cdr rest)))))])
-;;        loop)
-;;      x1
-;;      x2
-;;      rest)]
-;;    [(x1) (+ x1)]
-;;    [() (+)])
-#|=> (case-lambda
-  [(x1 x2) (+ x1 x2)]
-  [(x1 x2 x3) (+ (+ x1 x2) x3)]
-  [(x1 x2 . rest)
-   ((letrec ([loop (lambda (x1 x2 rest)
-                     (let ([x (+ x1 x2)])
-                       (if (null? rest)
-                           x
-                           (loop x (car rest) (cdr rest)))))])
-      loop)
-     x1
-     x2
-     rest)]
-  [(x1) (+ x1)]
-  [() (+)])
-  |#
-(do-test (quote '(case-lambda
-  [(x1 x2) (+ x1 x2)]
-  [(x1 x2 x3) (+ (+ x1 x2) x3)]
-  [(x1 x2 . rest)
-   ((letrec ([loop (lambda (x1 x2 rest)
-                     (let ([x (+ x1 x2)])
-                       (if (null? rest)
-                           x
-                           (loop x (car rest) (cdr rest)))))])
-      loop)
-     x1
-     x2
-     rest)]
-  [(x1) (+ x1)]
-  [() (+)])) "((result \"(case-lambda\\n  [(x1 x2) (+ x1 x2)]\\n  [(x1 x2 x3) (+ (+ x1 x2) x3)]\\n  [(x1 x2 . rest)\\n   ((letrec ([loop (lambda (x1 x2 rest)\\n                     (let ([x (+ x1 x2)])\\n                       (if (null? rest)\\n                           x\\n                           (loop x (car rest) (cdr rest)))))])\\n      loop)\\n     x1\\n     x2\\n     rest)]\\n  [(x1) (+ x1)]\\n  [() (+)])\\n\") (output . \"\"))\n")
diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss
new file mode 100644
index 0000000..33d1b39
--- /dev/null
+++ b/src/geiser/geiser.ss
@@ -0,0 +1,155 @@
+(library (geiser)
+  (export geiser:eval
+          geiser:completions
+          geiser:module-completions
+          geiser:autodoc
+          geiser:no-values
+          geiser:load-file
+          geiser:newline
+          geiser:macroexpand)
+  (import (chezscheme))
+
+  (define (last-index-of str-list char idx last-idx)
+    (if (null? str-list)
+        last-idx
+        (last-index-of (cdr str-list) char (+ 1 idx) (if (char=? char (car str-list)) idx last-idx))))
+
+  (define (obj-file-name name)
+    (let ((idx (last-index-of (string->list name) #\. 0 -1)))
+      (if (= idx -1)
+          (string-append name ".so")
+          (string-append (substring name 0 idx) ".so"))))
+
+  (define (geiser:load-file filename)
+    (let ((output-filename (obj-file-name filename)))
+      (maybe-compile-file filename output-filename)
+      (load output-filename)))
+
+  (define string-prefix?
+    (lambda (x y)
+      (let ([n (string-length x)])
+        (and (fx<= n (string-length y))
+             (let prefix? ([i 0])
+               (or (fx= i n)
+                   (and (char=? (string-ref x i) (string-ref y i))
+                        (prefix? (fx+ i 1)))))))))
+
+  (define (geiser:completions prefix . rest)
+    rest
+    (sort string-ci<?
+          (filter (lambda (el)
+                    (string-prefix? prefix el))
+                  (map write-to-string (environment-symbols (interaction-environment))))))
+
+  (define (write-to-string x)
+    (with-output-to-string
+      (lambda ()
+        (write x))))
+
+  (define (geiser:eval module form . rest)
+    rest
+    (let ((output-string (open-output-string)))
+      (write
+       (call/cc
+        (lambda (k)
+          (with-exception-handler
+              (lambda (e)
+                (k `((result "")
+                     (output . ,(with-output-to-string
+                                  (lambda ()
+                                    (display-condition e))))
+                     (error (key . chez-error-message)))))
+            (lambda ()
+              (call-with-values
+                  ;; evaluate form, allow for multiple return values,
+                  ;; and capture output in output-string.
+                  (lambda ()
+                    (parameterize ((current-output-port output-string))
+                      (if module
+                          (eval form (environment module))
+                          (eval form))))
+                (lambda result
+                  `((result ,(with-output-to-string
+                               (lambda ()
+                                 (pretty-print
+                                  (if (null? (cdr result)) (car result) result)))))
+                    (output . ,(get-output-string output-string))))))))))
+      (newline)
+      (close-output-port output-string)))
+
+  (define (geiser:module-completions prefix . rest)
+    (define (substring? s1 s2)
+      (let ([n1 (string-length s1)] [n2 (string-length s2)])
+        (let loop2 ([i2 0])
+          (let loop1 ([i1 0] [j i2])
+            (if (fx= i1 n1)
+                i2
+                (and (not (fx= j n2))
+                     (if (char=? (string-ref s1 i1) (string-ref s2 j))
+                         (loop1 (fx+ i1 1) (fx+ j 1))
+                         (loop2 (fx+ i2 1)))))))))
+    (filter (lambda (el)
+              (substring? prefix el))
+            (map write-to-string (library-list))))
+
+  (define (procedure-parameter-list p)
+    ;; same as (inspect object), then hitting c
+    (let ((s (((inspect/object p) 'code) 'source)))
+      (if s
+          (let ((form (s 'value)))
+            (if (and (list? form)
+                     (> (length form) 2)
+                     (eq? (car form) 'lambda))
+                (cadr form)
+                #f))
+          #f)))
+
+  (define (operator-arglist operator)
+    (let ((binding (eval operator)))
+      (if binding
+          (let ((arglist (procedure-parameter-list binding)))
+            (let loop ((arglist arglist)
+                       (optionals? #f)
+                       (required '())
+                       (optional '()))
+              (cond ((null? arglist)
+                     `(,operator ("args" (("required" ,@(reverse required))
+                                          ("optional" ,@(reverse optional))
+                                          ("key")
+                                          ;; ("module" ,module)
+                                          ))))
+                    ((symbol? arglist)
+                     (loop '()
+                           #t
+                           required
+                           (cons "..." (cons arglist optional))))
+                    (else
+                     (loop
+                      (cdr arglist)
+                      optionals?
+                      (if optionals? required (cons (car arglist) required))
+                      (if optionals? (cons (car arglist) optional) optional))))))
+          '())))
+
+  (define (geiser:autodoc ids . rest)
+    (cond ((null? ids) '())
+          ((not (list? ids))
+           (geiser:autodoc (list ids)))
+          ((not (symbol? (car ids)))
+           (geiser:autodoc (cdr ids)))
+          (else
+           (map (lambda (id)
+                  (operator-arglist id))
+                ids))))
+
+  (define (geiser:no-values)
+    #f)
+
+  (define (geiser:newline)
+    #f)
+
+  (define (geiser:macroexpand form . rest)
+    (with-output-to-string
+      (lambda ()
+        (pretty-print
+         (syntax->datum (expand form)))))))
diff --git a/src/geiser/test.ss b/src/geiser/test.ss
new file mode 100644
index 0000000..2407448
--- /dev/null
+++ b/src/geiser/test.ss
@@ -0,0 +1,120 @@
+(import (geiser)
+        (chezscheme))
+
+(define-syntax assert-equal
+  (syntax-rules ()
+    ((_ a b)
+     (if (equal? a b)
+         #t
+         (begin
+           (display (format "failed assertion `~a' == `~a'" a b))
+           (assert (equal? a b)))))))
+
+(define-syntax get-result
+  (syntax-rules ()
+    ((_ form)
+     (with-output-to-string
+       (lambda ()
+         (geiser:eval #f form))))))
+
+(define-syntax do-test
+  (syntax-rules ()
+    ((_ form result)
+     (assert
+      (equal?
+       (get-result form)
+       result)))))
+
+(define-syntax do-test-macroexpand
+  (syntax-rules ()
+    ((_ form result)
+     (assert
+      (equal? (geiser:macroexpand form)
+              result)))))
+
+(define-syntax test-or
+  (syntax-rules ()
+    ((_ x) x)
+    ((_ x xs ...)
+     (if x
+         x
+         (test-or xs ...)))))
+
+(do-test-macroexpand
+ '(test-or 1)
+ '1)
+
+(do-test-macroexpand
+ '(test-or 1 2)
+ '(if 1 1 2))
+
+;; (something-doesnot-exist)
+;;=> Error: Exception: variable something-doesnot-exist is not bound
+(do-test
+ '(something-doesnot-exist)
+ "((result \"\") (output . \"\") (error (key . \"Exception: variable something-doesnot-exist is not bound\")))\n"
+ )
+
+;; (make-violation)
+;;=> #<condition &violation>
+(do-test
+ '(make-violation)
+ "((result \"#<condition &violation>\\n\") (output . \"\"))\n")
+
+;; (values 1 2 3)
+;;==> (1 2 3)
+(do-test
+ '(values 1 2 3)
+ "((result \"(1 2 3)\\n\") (output . \"\"))\n")
+
+;; 1
+;;=> 1
+(do-test '1 "((result \"1\\n\") (output . \"\"))\n")
+
+
+;; '(case-lambda
+;;    [(x1 x2) (+ x1 x2)]
+;;    [(x1 x2 x3) (+ (+ x1 x2) x3)]
+;;    [(x1 x2 . rest)
+;;     ((letrec ([loop (lambda (x1 x2 rest)
+;;                    (let ([x (+ x1 x2)])
+;;                      (if (null? rest)
+;;                          x
+;;                          (loop x (car rest) (cdr rest)))))])
+;;        loop)
+;;      x1
+;;      x2
+;;      rest)]
+;;    [(x1) (+ x1)]
+;;    [() (+)])
+#|=> (case-lambda
+  [(x1 x2) (+ x1 x2)]
+  [(x1 x2 x3) (+ (+ x1 x2) x3)]
+  [(x1 x2 . rest)
+   ((letrec ([loop (lambda (x1 x2 rest)
+                     (let ([x (+ x1 x2)])
+                       (if (null? rest)
+                           x
+                           (loop x (car rest) (cdr rest)))))])
+      loop)
+     x1
+     x2
+     rest)]
+  [(x1) (+ x1)]
+  [() (+)])
+  |#
+(do-test (quote '(case-lambda
+  [(x1 x2) (+ x1 x2)]
+  [(x1 x2 x3) (+ (+ x1 x2) x3)]
+  [(x1 x2 . rest)
+   ((letrec ([loop (lambda (x1 x2 rest)
+                     (let ([x (+ x1 x2)])
+                       (if (null? rest)
+                           x
+                           (loop x (car rest) (cdr rest)))))])
+      loop)
+     x1
+     x2
+     rest)]
+  [(x1) (+ x1)]
+  [() (+)])) "((result \"(case-lambda\\n  [(x1 x2) (+ x1 x2)]\\n  [(x1 x2 x3) (+ (+ x1 x2) x3)]\\n  [(x1 x2 . rest)\\n   ((letrec ([loop (lambda (x1 x2 rest)\\n                     (let ([x (+ x1 x2)])\\n                       (if (null? rest)\\n                           x\\n                           (loop x (car rest) (cdr rest)))))])\\n      loop)\\n     x1\\n     x2\\n     rest)]\\n  [(x1) (+ x1)]\\n  [() (+)])\\n\") (output . \"\"))\n")
-- 
cgit v1.2.3