From 9686bbe3681cf8be446a4e009dc358241604879d Mon Sep 17 00:00:00 2001
From: Lassi Kortela <lassi@lassi.io>
Date: Thu, 28 Mar 2019 02:38:45 +0200
Subject: [PATCH] Extract parser code from rnrs-metadata

- Port from Racket to R7RS (code stays almost the same).
- Add Scheme library definition (.sld) file.
- Add main program for testing.
---
 test-chibi.scm | 15 ++++++++++++
 tex-parser.scm | 65 ++++++++++++++++++++++++++++++++++++++++++++++++++
 tex-parser.sld |  4 ++++
 3 files changed, 84 insertions(+)
 create mode 100755 test-chibi.scm
 create mode 100644 tex-parser.scm
 create mode 100644 tex-parser.sld

diff --git a/test-chibi.scm b/test-chibi.scm
new file mode 100755
index 0000000..051b67b
--- /dev/null
+++ b/test-chibi.scm
@@ -0,0 +1,15 @@
+#! /usr/bin/env chibi-scheme
+
+(import (scheme base)
+        (scheme file)
+        (scheme process-context)
+        (scheme write)
+        (tex-parser))
+
+(define (main arguments)
+  (for-each (lambda (tex-file)
+              (display (call-with-input-file tex-file parse-tex-from-port))
+              (newline))
+            (cdr arguments)))
+
+(main (command-line))
diff --git a/tex-parser.scm b/tex-parser.scm
new file mode 100644
index 0000000..a10fd73
--- /dev/null
+++ b/tex-parser.scm
@@ -0,0 +1,65 @@
+(define (match-char? k char)
+  (cond ((procedure? k) (not (not (k char))))
+        ((char? k) (equal? k char))
+        (else #f)))
+
+(define (read-char? k)
+  ;;(fprintf (current-error-port) "read-char? ~a~%" k)
+  (and (match-char? k (peek-char))
+       (begin (let ((char (read-char)))
+                ;;(display char (current-error-port))
+                ;;(newline (current-error-port))
+                char))))
+
+(define (read-char* k)
+  (let* ((first-char (read-char? k))
+         (chars (let ((out (open-output-string)))
+                  (let loop ((char first-char))
+                    (cond ((or (equal? #f char) (eof-object? char))
+                           (get-output-string out))
+                          (else
+                           (write-char char out)
+                           (loop (read-char? k))))))))
+    (if (= 0 (string-length chars)) #f chars)))
+
+(define (tex-command-char? ch)
+  (or (char-alphabetic? ch)
+      (char-numeric? ch)))
+
+(define (not-tex-special-char? ch)
+  (not (or (equal? ch #\{)
+           (equal? ch #\})
+           (equal? ch #\\))))
+
+(define (read-tex-command-args)
+  (let loop ((args '()))
+    (if (not (read-char? #\{))
+        args
+        (loop (append args (list (read-tex-until #\})))))))
+
+(define (read-tex-thing)
+  (cond ((read-char? #\\)
+         (let ((command (read-char* tex-command-char?)))
+           (cond (command
+                  (cons (string->symbol command)
+                        (read-tex-command-args)))
+                 (else
+                  (read-char* not-tex-special-char?)))))
+        ((read-char? #\{)
+         (cons 'math (read-tex-until #\})))
+        (else (read-char* not-tex-special-char?))))
+
+(define (read-tex-until sentinel)
+  (let loop ((things '()))
+    (if (read-char? sentinel)
+        things
+        (let ((thing (read-tex-thing)))
+          (cond ((not thing)
+                 things)
+                (else
+                 ;;(fprintf (current-error-port) "Read thing: ~a~%" thing)
+                 (loop (append things (list thing)))))))))
+
+(define (parse-tex-from-port char-input-port)
+  (parameterize ((current-input-port char-input-port))
+    (read-tex-until eof-object?)))
diff --git a/tex-parser.sld b/tex-parser.sld
new file mode 100644
index 0000000..bfb7ae1
--- /dev/null
+++ b/tex-parser.sld
@@ -0,0 +1,4 @@
+(define-library (tex-parser)
+  (export parse-tex-from-port)
+  (import (scheme base) (scheme char) (scheme file))
+  (include "tex-parser.scm"))