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.
This commit is contained in:
Lassi Kortela 2019-03-28 02:38:45 +02:00
parent e3042763ac
commit 9686bbe368
3 changed files with 84 additions and 0 deletions

15
test-chibi.scm Executable file
View File

@ -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))

65
tex-parser.scm Normal file
View File

@ -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?)))

4
tex-parser.sld Normal file
View File

@ -0,0 +1,4 @@
(define-library (tex-parser)
(export parse-tex-from-port)
(import (scheme base) (scheme char) (scheme file))
(include "tex-parser.scm"))