From 38c118ea2d95e68a6854579a281eb8af19064902 Mon Sep 17 00:00:00 2001
From: Peter <craven@gmx.net>
Date: Tue, 26 Apr 2016 22:27:26 +0200
Subject: Add preliminary support for Chez Scheme

---
 scheme/chez/geiser/geiser.ss | 62 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 scheme/chez/geiser/geiser.ss

(limited to 'scheme/chez')

diff --git a/scheme/chez/geiser/geiser.ss b/scheme/chez/geiser/geiser.ss
new file mode 100644
index 0000000..3dbed7f
--- /dev/null
+++ b/scheme/chez/geiser/geiser.ss
@@ -0,0 +1,62 @@
+(library (geiser)
+  (export geiser:eval
+          geiser:completions
+          geiser:module-completions
+          geiser:autodoc
+          geiser:no-values
+          geiser:newline)
+  (import (chezscheme))
+
+  (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 ((result (if module
+                      (eval form (environment module))
+                      (eval form))))
+      (write `((result ,(write-to-string result))
+               (output . "")))
+      (newline)))
+
+  (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 (geiser:autodoc ids . rest)
+    '())
+
+  (define (geiser:no-values)
+    #f)
+
+  (define (geiser:newline)
+    #f))
-- 
cgit v1.2.3