encoding-reader-simple.scm

@@ -1,61 +0,0 @@
-(import (scheme base) (scheme char) (scheme file)
-        (scheme read) (scheme write))
-
-(define (read-declarations-from-file 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 (peek-next-ascii-byte)
-      (if (not (< i (bytevector-length bytes)))
-          (eof-object)
-          (let ((next-byte (bytevector-u8-ref bytes i)))
-            (if (<= 1 next-byte 126)
-                next-byte
-                (begin (set! i (+ i 1))
-                       (peek-next-ascii-byte))))))
-    (define (read-char? k)
-      (let* ((next-byte (peek-next-ascii-byte))
-             (next-char (if (eof-object? next-byte)
-                            next-byte (integer->char 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 (read-char* k)
-      (let loop ((chars '()))
-        (let ((c (read-char? k)))
-          (if c (loop (append chars (list c)))
-              (if (null? chars) #f (list->string chars))))))
-    (define (symbol-char? c)
-      (not (or (eof-object? c) (char-whitespace? c)
-               (eqv? c #\") (eqv? c #\() (eqv? c #\)))))
-    (define (read->eol)
-      (read-char* (lambda (c) (not (eqv? c #\newline)))))
-    (define (skip-white-comm)
-      (cond ((read-char? #\;) (read->eol) (skip-white-comm))
-            ((read-char? char-whitespace?) (skip-white-comm))
-            (else #f)))
-    (define (read-lexeme)
-      (skip-white-comm)
-      (cond ((read-char? #\()) ((read-char? #\))) ((read-char* symbol-char?))
-            (else #f)))
-    (let* ((shebang (and (read-char? #\#) (read-char? #\!) (read->eol))))
-      (cons shebang
-            (and (eqv? (read-lexeme) #\() (equal? (read-lexeme) "declare-file")
-                 (eqv? (read-lexeme) #\() (equal? (read-lexeme) "coding")
-                 (let ((coding (read-lexeme)))
-                   (and (string? coding) (eqv? (read-lexeme) #\))
-                        (string-downcase coding))))))))
-
-(define (writeln x)
-  (write x)
-  (newline))
-
-(writeln (read-declarations-from-file "test-big5.scm"))
-(writeln (read-declarations-from-file "test-euc-jp.scm"))
-(writeln (read-declarations-from-file "test-shift-jis.scm"))
-(writeln (read-declarations-from-file "test-utf16-be.scm"))
-(writeln (read-declarations-from-file "test-utf16-le.scm"))

encoding-reader.scm

@@ -10,19 +10,17 @@
                              (lambda (port) (read-bytevector 1000 port)))))
                  (if (eof-object? bytes) (make-bytevector 0) bytes)))
         (i 0))
-    (define (peek-next-ascii-byte)
-      (if (not (< i (bytevector-length bytes)))
-          (eof-object)
-          (let ((next-byte (bytevector-u8-ref bytes i)))
-            (if (<= 1 next-byte 126)
-                next-byte
-                (begin (set! i (+ i 1))
-                       (peek-next-ascii-byte))))))
     (define (read-char? k)
-      (let* ((next-byte (peek-next-ascii-byte))
+      (let* ((remain? (< i (bytevector-length bytes)))
-             (next-char (if (eof-object? next-byte)
+             (next-byte (if remain?
-                            next-byte
+                            (bytevector-u8-ref bytes i)
-                            (integer->char next-byte)))
+                            (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))))
@@ -42,13 +40,6 @@
                (eqv? c #\")
                (eqv? c #\()
                (eqv? c #\)))))
-    (define (string-char? c)
-      (not (or (eof-object? c)
-               (eqv? c #\tab)
-               (eqv? c #\newline)
-               (eqv? c #\return)
-               (eqv? c #\")
-               (eqv? c #\\))))
     (define (skip-char* k)
       (when (read-char? k) (skip-char* k)))
     (define (read-rest-of-line)
@@ -69,14 +60,6 @@
                   #f
                   (list->string chars))
               (loop (append chars (list c)))))))
-    (define (read-string)
-      (let loop ((chars '()))
-        (if (read-char? #\")
-            (list->string chars)
-            (let ((c (read-char? string-char?)))
-              (if (not c)
-                  (eof-object)
-                  (loop (append chars (list c))))))))
     (define (read-list)
       (let loop ((xs '()))
         (skip-whitespace-and-comments)
@@ -88,23 +71,19 @@
                   (loop (append xs (list x))))))))
     (define (read-form)
       (skip-whitespace-and-comments)
-      (cond ((read-char? #\()
+      (if (read-char? #\()
-             (read-list))
+          (read-list)
-            ((read-char? #\")
-             (read-string))
-            (else
           (let ((symbol-name (read-char* not-special-char?)))
             (if symbol-name
                 (string->symbol symbol-name)
-                   (eof-object))))))
+                (eof-object)))))
     (let* ((shebang (if (and (read-char? #\#) (read-char? #\!))
                         (read-rest-of-line)
                         #f))
            (first-form (read-form))
-           (declarations (or (and (list? first-form)
+           (declarations (and (list? first-form)
                               (eqv? 'declare-file (car first-form))
-                                  (cdr first-form))
+                              (cdr first-form))))
-                             '())))
       (if shebang
           (cons (list 'shebang shebang) declarations)
           declarations))))
@@ -113,12 +92,4 @@
   (write x)
   (newline))
 
-(define (try-file filename)
+(for-each writeln (read-declarations-from-file "test.scm"))
-  (for-each writeln (read-declarations-from-file filename))
-  (newline))
-
-(try-file "test-big5.scm")
-(try-file "test-euc-jp.scm")
-(try-file "test-shift-jis.scm")
-(try-file "test-utf16-be.scm")
-(try-file "test-utf16-le.scm")

test-big5.scm

@@ -1,10 +0,0 @@
-#! /usr/bin/env gosh
-
-(declare-file
- (coding Big5)
- (language scheme r7rs)
- (copyright 2019 "Lassi Kortela")
- (spdx-license-identifier "ISC"))
-
-(display "你好世界")
-(newline)

test-euc-jp.scm

@@ -1,10 +0,0 @@
-#! /usr/bin/env gosh
-
-(declare-file
- (coding EUC-JP)
- (language scheme r7rs)
- (copyright 2019 "Lassi Kortela")
- (spdx-license-identifier "ISC"))
-
-(display "こんにちは世界")
-(newline)

test-kawa.sh

@@ -1,2 +0,0 @@
-#!/bin/sh
-kawa encoding-reader.scm

test-shift-jis.scm

@@ -1,10 +0,0 @@
-#! /usr/bin/env gosh
-
-(declare-file
- (coding shift_jis)
- (language scheme r7rs)
- (copyright 2019 "Lassi Kortela")
- (spdx-license-identifier "ISC"))
-
-(display "こんにちは世界")
-(newline)

test.scm

@@ -0,0 +1,7 @@
+#! /usr/bin/env gosh
+
+(declare-file
+ (coding shift_jis))
+
+(display "こんにちは世界")
+(newline)