From 2773292aaffa41c418c5d495bf8a491dcb7b9223 Mon Sep 17 00:00:00 2001
From: Lassi Kortela <lassi@lassi.io>
Date: Sun, 12 May 2019 16:10:10 +0300
Subject: [PATCH] Initial commit

---
 encoding-reader.scm | 91 +++++++++++++++++++++++++++++++++++++++++++++
 test-chibi.sh       |  2 +
 test-gauche.sh      |  2 +
 test.scm            |  4 ++
 4 files changed, 99 insertions(+)
 create mode 100644 encoding-reader.scm
 create mode 100755 test-chibi.sh
 create mode 100755 test-gauche.sh
 create mode 100644 test.scm

diff --git a/encoding-reader.scm b/encoding-reader.scm
new file mode 100644
index 0000000..8c5db83
--- /dev/null
+++ b/encoding-reader.scm
@@ -0,0 +1,91 @@
+(import (scheme base)
+        (scheme cxr)
+        (scheme file)
+        (scheme read)
+        (scheme write))
+
+(define (read-encoding filename)
+  (let ((bytes (let ((bytes (call-with-port
+                             (open-binary-input-file filename)
+                             (lambda (port) (read-bytevector 1000 port)))))
+                 (if (eof-object? bytes) (make-bytevector 0) bytes)))
+        (i 0))
+    (define (read-char? k)
+      (let* ((remain? (< i (bytevector-length bytes)))
+             (next-byte (if remain?
+                            (bytevector-u8-ref bytes i)
+                            (eof-object)))
+             (next-char (cond ((eof-object? next-byte)
+                               next-byte)
+                              ((<= 1 next-byte 126)
+                               (integer->char next-byte))
+                              (else
+                               next-byte)))
+             (consume? (cond ((procedure? k) (k next-char))
+                             ((char? k) (eqv? k next-char))
+                             (else #f))))
+        (cond (consume?
+               (set! i (+ i 1))
+               next-char)
+              (else
+               #f))))
+    (define (whitespace-char? c)
+      (or (eqv? c #\space)
+          (eqv? c #\tab)
+          (eqv? c #\newline)
+          (eqv? c #\return)))
+    (define (not-special-char? c)
+      (not (or (eof-object? c)
+               (whitespace-char? c)
+               (eqv? c #\")
+               (eqv? c #\()
+               (eqv? c #\)))))
+    (define (skip-char* k)
+      (when (read-char? k) (skip-char* k)))
+    (define (skip-rest-of-line)
+      (skip-char* (lambda (c) (not (or (eof-object? c) (eqv? c #\newline))))))
+    (define (skip-whitespace-and-comments)
+      (cond ((read-char? #\;)
+             (skip-rest-of-line)
+             (skip-whitespace-and-comments))
+            ((read-char? whitespace-char?)
+             (skip-char* whitespace-char?)
+             (skip-whitespace-and-comments))
+            (else #f)))
+    (define (read-char* k)
+      (let loop ((chars '()))
+        (let ((c (read-char? k)))
+          (if (not c)
+              (if (null? chars)
+                  #f
+                  (list->string chars))
+              (loop (append chars (list c)))))))
+    (define (read-list)
+      (let loop ((xs '()))
+        (skip-whitespace-and-comments)
+        (if (read-char? #\))
+            xs
+            (let ((x (read-form)))
+              (if (eof-object? x)
+                  x
+                  (loop (append xs (list x))))))))
+    (define (read-form)
+      (skip-whitespace-and-comments)
+      (if (read-char? #\()
+          (read-list)
+          (let ((symbol-name (read-char* not-special-char?)))
+            (if symbol-name
+                (string->symbol symbol-name)
+                (eof-object)))))
+    (let* ((form (read-form))
+           (coding-pair (and (list? form) (assoc 'coding (cdr form))))
+           (coding (if (and coding-pair
+                            (pair? (cdr coding-pair))
+                            (null? (cddr coding-pair))
+                            (symbol? (cadr coding-pair)))
+                       (cadr coding-pair)
+                       #f)))
+      coding)))
+
+(display (read-encoding "test.scm"))
+(newline)
diff --git a/test-chibi.sh b/test-chibi.sh
new file mode 100755
index 0000000..5ec511d
--- /dev/null
+++ b/test-chibi.sh
@@ -0,0 +1,2 @@
+#!/bin/sh
+chibi-scheme encoding-reader.scm
diff --git a/test-gauche.sh b/test-gauche.sh
new file mode 100755
index 0000000..866c7ee
--- /dev/null
+++ b/test-gauche.sh
@@ -0,0 +1,2 @@
+#!/bin/sh
+gosh encoding-reader.scm
diff --git a/test.scm b/test.scm
new file mode 100644
index 0000000..29839fa
--- /dev/null
+++ b/test.scm
@@ -0,0 +1,4 @@
+(declare-file
+ (coding shift_jis))
+
+(display "こんにちは世界")