Split read-char? and kin into their own library

This commit is contained in:
Lassi Kortela 2019-03-28 12:28:51 +02:00
parent 9686bbe368
commit 3ee2d6915b
4 changed files with 33 additions and 25 deletions

23
read-char-if.scm Normal file
View File

@ -0,0 +1,23 @@
(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)))

6
read-char-if.sld Normal file
View File

@ -0,0 +1,6 @@
(define-library (read-char-if)
(export read-char? read-char*)
(import (scheme base)
(scheme char)
(scheme file))
(include "read-char-if.scm"))

View File

@ -1,27 +1,3 @@
(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)))

View File

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