Added comments to telml.scm and allowed numbers in tag names
Getty Ritter
8 years ago
| 16 | 16 | (title meta-title) |
| 17 | 17 | (tags meta-tags)) |
| 18 | 18 | |
| 19 | ;; This builds a stream abstraction, where a stream is a stream of | |
| 20 | ;; characters. This makes writing a parser a _lot_ easier. | |
| 19 | 21 | (define (mk-stream s) |
| 20 | 22 | (let ((lst (string->list s))) |
| 21 | 23 | (lambda (msg) |
| 32 | 34 | (cadr lst))) |
| 33 | 35 | ((eq? 'done msg) (null? lst)))))) |
| 34 | 36 | |
| 37 | ;; Special characters in TeLML are in the set [\{}|], and this also | |
| 38 | ;; considers EOF to be a special character. | |
| 35 | 39 | (define (special-char? c) |
| 36 | 40 | (or (eq? c #\\) |
| 37 | 41 | (eq? c #\{) |
| 39 | 43 | (eq? c #\|) |
| 40 | 44 | (not c))) |
| 41 | 45 | |
| 46 | ;; This turns a stream back into a proper list, mostly for debugging | |
| 47 | ;; purposes. | |
| 42 | 48 | (define (stream->list s) |
| 43 | 49 | (if (s 'peek) (cons (s 'next) (stream->list s)) '())) |
| 44 | 50 | |
| 51 | ;; Identifiers consist of the characters [A-Za-z0-9_-], which are | |
| 52 | ;; matched here by number. | |
| 45 | 53 | (define (ident-char? c) |
| 46 | 54 | (let ((i (char->integer c))) |
| 47 |
(or (= i 45) |
|
| 55 | (or (= i 45) | |
| 56 | (= i 95) | |
| 57 | (and (>= i 48) (<= i 57)) | |
| 48 | 58 | (and (>= i 64) (<= i 90)) |
| 49 | 59 | (and (>= i 97) (<= i 122))))) |
| 50 | 60 | |
| 61 | ;; Whitespace is in [\t\r\n ] | |
| 51 | 62 | (define (whitespace? c) |
| 52 | 63 | (let ((i (char->integer c))) |
| 53 | 64 | (or (= i 9) (= i 10) (= i 13) (= i 32)))) |
| 54 | 65 | |
| 66 | ;; Our parsing function consists of a number of mutually recursive | |
| 67 | ;; functions that operate over a stream of characters. | |
| 55 | 68 | (define (parse str) |
| 56 | 69 | (let ((s (mk-stream str))) |
| 57 | 70 | |
| 58 | 71 | (define (match-char c) |
| 59 |
(if (eq? (s 'next) c) #t ( |
|
| 72 | (if (eq? (s 'next) c) #t (throw 'unexpected-char c))) | |
| 60 | 73 | |
| 61 | 74 | (define (parse-tag) |
| 62 | 75 | (let* ((_ (match-char #\\)) |
| 187 | 200 | (partition (go document) '(()))) |
| 188 | 201 | |
| 189 | 202 | (define (string->sexp str) |
| 190 |
(ca |
|
| 203 | (catch 'read-error | |
| 204 | (lambda () (call-with-input-string str read)) | |
| 205 | (lambda _ #f))) | |
| 191 | 206 | |
| 192 | 207 | (define (escape-chars str) |
| 193 | 208 | (define (go c rest) |
| 204 | 219 | (define (telml->sxml telml tags) |
| 205 | 220 | (define (rec arg) |
| 206 | 221 | (cond ((string? arg) (escape-chars arg)) |
| 222 | ((null? arg) '()) | |
| 207 | 223 | ((symbol? (car arg)) |
| 208 | 224 | (let ((args (map rec (cdr arg))) |
| 209 | 225 | (func (assoc (car arg) tags))) |