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:
parent
e3042763ac
commit
9686bbe368
|
@ -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))
|
|
@ -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?)))
|
|
@ -0,0 +1,4 @@
|
||||||
|
(define-library (tex-parser)
|
||||||
|
(export parse-tex-from-port)
|
||||||
|
(import (scheme base) (scheme char) (scheme file))
|
||||||
|
(include "tex-parser.scm"))
|
Loading…
Reference in New Issue