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