nyacc: fixed C99 CPP to deal with numbers correctly
[mes.git] / module / nyacc / lex.scm
1 ;;; nyacc/lex.scm
2 ;;;
3 ;;; Copyright (C) 2015-2017 - Matthew R.Wette
4 ;;; 
5 ;;; This library is free software; you can redistribute it and/or modify it
6 ;;; under the terms of the GNU Lesser General Public License as published by
7 ;;; the Free Software Foundation; either version 3 of the License, or (at
8 ;;; your option) any later version.
9 ;;;
10 ;;; This library is distributed in the hope that it will be useful, but
11 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13 ;;; Lesser General Public License for more details.
14 ;;;
15 ;;; You should have received a copy of the GNU Lesser General Public License
16 ;;; along with this library; if not, see <http://www.gnu.org/licenses/>
17
18 ;; A module providing procedures for constructing lexical analyzers.
19
20 ;; '$fixed '$float '$string '$chlit '$ident
21
22 ;; todo: change lexer to return @code{cons-source} instead of @code{cons}
23 ;; todo: to be fully compliant, C readers need to deal with \ at end of line
24
25 ;; todo: figure out what readers return atoms and which pairs
26 ;; tokens: read-c-ident 
27 ;; pairs: num-reader read-c-num read-c-string
28 ;; issue: if returning pairs we need this for hashed parsers:
29 ;;    (define (assc-$ pair) (cons (assq-ref symbols (car pair)) (cdr pair)))
30 ;; read-comm changed to (read-comm ch bol) where bol is begin-of-line cond
31 ;; 
32 ;; read-c-ident 
33
34 (define-module (nyacc lex)
35   #:export (make-lexer-generator
36             make-ident-reader
37             make-comm-reader
38             make-string-reader
39             make-chseq-reader
40             make-num-reader
41             eval-reader
42             make-like-ident-p
43             read-c-ident
44             read-c-comm
45             read-c-string
46             read-c-chlit
47             read-c-num
48             read-oct read-hex
49             like-c-ident?
50             cnumstr->scm
51             filter-mt remove-mt map-mt make-ident-like-p 
52             c:ws c:if c:ir)
53   #:use-module ((srfi srfi-1) #:select (remove append-reverse))
54   #:use-module (ice-9 pretty-print)
55   )
56
57 (cond-expand
58  (guile-2)
59  (guile
60   (use-modules (ice-9 syncase))
61   (use-modules (ice-9 optargs)))
62  (mes))
63
64 ;; @section Constructing Lexical Analyzers
65 ;; The @code{lex} module provides a set of procedures to build lexical
66 ;; analyzers.  The approach is to first build a set of @defn{readers} for 
67 ;; MORE TO COME
68 ;;
69 ;; Readers are procecures that take one character (presumably from the
70 ;; current-input-port) and determine try to make a match.   If a match is
71 ;; made something is returned, with any lookaheads pushed back into the
72 ;; input port.  If no match is made @code{#f} is returned and the input
73 ;; argument is still the character to work on.
74 ;;
75 ;; Here are the procedures used:
76 ;; @table @code
77
78 (define digit "0123456789")
79 (define ucase "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
80 (define lcase "abcdefghijklmnopqrstuvwxyz")
81
82 ;; C lexemes are popular so include those.
83 ;;(define c:ws (list->char-set '(#\space #\tab #\newline #\return )))
84 (define c:ws char-set:whitespace)
85 (define c:if (let ((cs (char-set #\_))) ; ident, first char
86                (string->char-set! ucase cs)
87                (string->char-set! lcase cs)))
88 (define c:ir (string->char-set digit c:if)) ; ident, rest chars
89 (define c:nx (string->char-set "eEdD")) ; number exponent
90 (define c:hx (string->char-set "abcdefABCDEF"))
91 (define c:sx (string->char-set "lLuU")) ; suffix
92
93 (define (lsr chl) (list->string (reverse chl))) ; used often
94
95 ;; @deffn eval-reader reader string => result
96 ;; For test and debug, this procedure will evaluate a reader on a string.
97 ;; A reader is a procedure that accepts a single character argument intended
98 ;; to match a specific character sequence.  A reader will read more characters
99 ;; by evaluating @code{read-char} until it matches or fails.  If it fails, it
100 ;; will pushback all characters read via @code{read-char} and return @code{#f}.
101 ;; If it succeeds the input pointer will be at the position following the
102 ;; last matched character.
103 (define (eval-reader reader string)
104   (with-input-from-string string
105     (lambda () (reader (read-char)))))
106
107 ;; @deffn make-space-skipper chset => proc
108 ;; This routine will generate a reader to skip whitespace.
109 (define (make-space-skipper chset)
110   (lambda (ch)
111     (if (char-set-contains? chset ch)
112         (let iter ((ch (read-char)))
113           (cond
114            ((char-set-contains? chset ch)
115             (iter (read-char)))
116            (else
117             (unread-char ch)
118             #t)))
119         #f)))
120          
121 ;; @deffn skip-c-space ch => #f|#t
122 ;; If @code{ch} is space, skip all spaces, then return @code{#t}, else
123 ;; return @code{#f}.
124 (define skip-c-space (make-space-skipper c:ws))
125
126
127 ;; @deffn make-ident-reader cs-first cs-rest => ch -> #f|string
128 ;; For identifiers, given the char-set for first character and the char-set
129 ;; for following characters, return a return a reader for identifiers.
130 ;; The reader takes a character as input and returns @code{#f} or @code{string}.
131 (define (make-ident-reader cs-first cs-rest)
132   (lambda (ch)
133     (if (char-set-contains? cs-first ch)
134         (let iter ((chl (list ch)) (ch (read-char)))
135           (cond
136            ((eof-object? ch)
137             (if (null? chl) #f
138                 (lsr chl)))
139            ((char-set-contains? cs-rest ch)
140             (iter (cons ch chl) (read-char)))
141            (else (unread-char ch)
142                  (lsr chl))))
143         #f)))
144
145 ;; @deffn read-c-ident ch => #f|string
146 ;; If ident pointer at following char, else (if #f) ch still last-read.
147 (define read-c-ident (make-ident-reader c:if c:ir))
148
149 ;; @deffn make-ident-like-p ident-reader
150 ;; Generate a predicate, from a reader, that determines if a string qualifies
151 ;; as an identifier.
152 (define (make-like-ident-p reader)
153   (lambda (s) (and (string? s) (eval-reader reader s))))
154 (define make-ident-like-p make-like-ident-p)
155 (define like-c-ident? (make-like-ident-p read-c-ident))
156
157
158 ;; @deffn make-string-reader delim
159 ;; Generate a reader that uses @code{delim} as delimiter for strings.
160 ;; TODO: need to handle matlab-type strings.
161 ;; TODO: need to handle multiple delim's (like python)
162 (define (make-string-reader delim) ;; #:xxx
163   (lambda (ch)
164     (if (eq? ch delim)
165         (let iter ((cl '()) (ch (read-char)))
166           (cond ((eq? ch #\\)
167                  (let ((c1 (read-char)))
168                    (if (eq? c1 #\newline)
169                        (iter cl (read-char))
170                        (iter (cons* c1 cl) (read-char)))))
171                 ((eq? ch delim) (cons '$string (lsr cl)))
172                 (else (iter (cons ch cl) (read-char)))))
173         #f)))
174
175 ;; @deffn read-oct ch => "0123"|#f
176 ;; Read octal number.
177 (define read-oct
178   (let ((cs:oct (string->char-set "01234567")))
179     (lambda (ch)
180       (let iter ((cv 0) (ch ch) (n 1))
181         (cond
182          ((eof-object? ch) cv)
183          ((> n 3) (unread-char ch) cv)
184          ((char-set-contains? cs:oct ch)
185           (iter (+ (* 8 cv) (- (char->integer ch) 48)) (read-char) (1+ n)))
186          (else
187           (unread-char ch)
188           cv))))))
189
190 ;; @deffn read-hex ch => "0x7f"|#f
191 ;; Read octal number.
192 (define read-hex
193   (let ((cs:dig (string->char-set "0123456789"))
194         (cs:uhx (string->char-set "ABCDEF"))
195         (cs:lhx (string->char-set "abcdef")))
196     (lambda (ch) ;; ch == #\x always
197       (let iter ((cv 0) (ch (read-char)) (n 0))
198         (simple-format #t "ch=~S\n" ch)
199         (cond
200          ((eof-object? ch) cv)
201          ((> n 2) (unread-char ch) cv)
202          ((char-set-contains? cs:dig ch)
203           (iter (+ (* 16 cv) (- (char->integer ch) 48)) (read-char) (1+ n)))
204          ((char-set-contains? cs:uhx ch)
205           (iter (+ (* 16 cv) (- (char->integer ch) 55)) (read-char) (1+ n)))
206          ((char-set-contains? cs:lhx ch)
207           (iter (+ (* 16 cv) (- (char->integer ch) 87)) (read-char) (1+ n)))
208          (else (unread-char ch) cv))))))
209         
210 ;; @deffn read-c-string ch => ($string . "foo")
211 ;; Read a C-code string.  Output to code is @code{write} not @code{display}.
212 ;; Return #f if @var{ch} is not @code{"}.
213 (define (read-c-string ch)
214   (if (not (eq? ch #\")) #f
215       (let iter ((cl '()) (ch (read-char)))
216         (cond ((eq? ch #\\)
217                (let ((c1 (read-char)))
218                  (iter
219                   (case c1
220                     ((#\newline) cl)
221                     ((#\\) (cons #\\ cl))
222                     ((#\") (cons #\" cl))
223                     ((#\') (cons #\' cl))
224                     ((#\n) (cons #\newline cl))
225                     ((#\r) (cons #\return cl))
226                     ((#\b) (cons #\backspace cl))
227                     ((#\t) (cons #\tab cl))
228                     ((#\f) (cons #\page cl))
229                     ((#\a) (cons #\alarm cl))
230                     ((#\v) (cons #\vtab cl))
231                     ((#\x) (cons (integer->char (read-hex ch)) cl))
232                     (else
233                      (if (char-numeric? ch)
234                          (cons (integer->char (read-oct ch)) cl)
235                          (cons c1 cl))))
236                   (read-char))))
237               ((eq? ch #\") (cons '$string (lsr cl)))
238               (else (iter (cons ch cl) (read-char)))))))
239
240 ;; @deffn make-chlit-reader
241 ;; Generate a reader for character literals. NOT DONE.
242 ;; For C, this reads @code{'c'} or @code{'\n'}.
243 (define (make-chlit-reader . rest) (error "NOT IMPLEMENTED"))
244
245 ;; @deffn read-c-chlit ch
246 ;; @example
247 ;; ... 'c' ... => (read-c-chlit #\') => '($ch-lit . #\c)
248 ;; @end example
249 (define (read-c-chlit ch)
250   (if (not (eqv? ch #\')) #f
251       (let ((c1 (read-char)) (c2 (read-char)))
252         (if (eqv? c1 #\\)
253             (let ((c3 (read-char)))
254               (cons '$chlit
255                     (case c2
256                       ((#\0) "\0;")        ; nul U+0000 (#\U+...)
257                       ((#\a) "\a")         ; alert U+0007
258                       ((#\b) "\b")         ; backspace U+0008
259                       ((#\t) "\t")         ; horizontal tab U+0009
260                       ((#\n) "\n")         ; newline U+000A
261                       ((#\v) "\v")         ; verticle tab U+000B
262                       ((#\f) "\f")         ; formfeed U+000C
263                       ((#\\) "\\")         ; backslash
264                       ((#\' #\" #\?) (string c2))
265                       (else (error "bad escape sequence")))))
266             (cons '$chlit (string c1))))))
267
268 (define (fix-dot l) (if (char=? #\. (car l)) (cons #\0 l) l))
269
270 ;; @deffn make-num-reader => (proc ch) => #f|($fixed . "1")|($float . "1.0")
271 ;; Reads C numbers.
272 ;; This routine will clean by adding "0" before or after dot.
273 ;; may want to replace "eEdD" w/ "e"
274 ;; integer decimal(#t/#f) fraction exponent looking-at
275 ;; i, f and e are lists of characters
276 (define (make-num-reader)
277   ;; 0: start; 1: p-i; 2: p-f; 3: p-e-sign; 4: p-e-d; 5: packup
278   ;; Removed support for leading '.' to be a number.
279   (lambda (ch1)
280     ;; chl: char list; ty: '$fixed or '$float; st: state; ch: input char
281     (let iter ((chl '()) (ty #f) (st 0) (ch ch1))
282       (case st
283         ((0)
284          (cond
285           ((eof-object? ch) (iter chl ty 5 ch))
286           ((char=? #\0 ch) (iter (cons ch chl) '$fixed 10 (read-char))) 
287           ((char-numeric? ch) (iter chl '$fixed 1 ch))
288           (else #f)))
289         ((10) ;; allow x after 0
290          (cond
291           ((eof-object? ch) (iter chl ty 5 ch))
292           ((char=? #\x ch) (iter (cons ch chl) ty 1 (read-char)))
293           (else (iter chl ty 1 ch))))
294         ((1)
295          (cond
296           ((eof-object? ch) (iter chl ty 5 ch))
297           ((char-numeric? ch) (iter (cons ch chl) ty 1 (read-char)))
298           ((char=? #\. ch) (iter (cons #\. chl) '$float 2 (read-char)))
299           ((char-set-contains? c:hx ch)
300            (iter (cons ch chl) ty 1 (read-char)))
301           ((char-set-contains? c:sx ch)
302            (iter (cons ch chl) ty 11 (read-char)))
303           ((char-set-contains? c:if ch) (error "lex/num-reader st=1"))
304           (else (iter chl '$fixed 5 ch))))
305         ((11) ;; got l L u or U, look for l or L
306          (cond
307           ((eof-object? ch) (cons '$fixed (lsr chl)))
308           ((char=? #\L ch) (cons '$fixed (lsr (cons ch chl))))
309           ((char=? #\l ch) (cons '$fixed (lsr (cons ch chl))))
310           (else (iter chl '$fixed 5 ch))))
311         ((2)
312          (cond
313           ((eof-object? ch) (iter chl ty 5 ch))
314           ((char-numeric? ch) (iter (cons ch chl) ty 2 (read-char)))
315           ((char-set-contains? c:nx ch)
316            (iter (cons ch (fix-dot chl)) ty 3 (read-char)))
317           ((char-set-contains? c:if ch) (error "lex/num-reader st=2"))
318           (else (iter (fix-dot chl) ty 5 ch))))
319         ((3)
320          (cond
321           ((eof-object? ch) (iter chl ty 5 ch))
322           ((or (char=? #\+ ch) (char=? #\- ch))
323            (iter (cons ch chl) ty 4 (read-char)))
324           ((char-numeric? ch) (iter chl ty 4 ch))
325           (else (error "syntax3"))))
326         ((4)
327          (cond
328           ((eof-object? ch) (iter chl ty 5 ch))
329           ((char-numeric? ch) (iter (cons ch chl) ty 4 (read-char)))
330           ((char-set-contains? c:if ch) (error "lex/num-reader st=4"))
331           (else (iter chl ty 5 ch))))
332         ((5)
333          (unless (eof-object? ch) (unread-char ch))
334          (cons ty (lsr chl)))))))
335
336 ;; @deffn cnumstr->scm C99-str => scm-str
337 ;; Convert C number-string (e.g, @code{0x123LL}) to Scheme numbers-string
338 ;; (e.g., @code{#x123}).
339 (define (cnumstr->scm str)
340   (define (2- n) (1- (1- n)))
341   (let* ((nd (string-length str)))
342     (define (trim-rt st) ;; trim LlUu from right
343       (if (char-set-contains? c:sx (string-ref str (1- nd)))
344           (if (char-set-contains? c:sx (string-ref str (2- nd)))
345               (substring str st (2- nd))
346               (substring str st (1- nd)))
347           (substring str st nd)))
348     (if (< nd 2) str
349         (if (char=? #\0 (string-ref str 0))
350             (if (char=? #\x (string-ref str 1))
351                 (string-append "#x" (trim-rt 2))
352                 (if (char-numeric? (string-ref str 1))
353                     (string-append "#o" (trim-rt 1))
354                     (trim-rt 0)))
355             (trim-rt 0)))))
356   
357 ;; @deffn read-c-num ch => #f|string
358 ;; Reader for unsigned numbers as used in C (or close to it).
359 (define read-c-num (make-num-reader))
360
361 ;;.@deffn si-map string-list ix => a-list
362 ;; Convert list of strings to alist of char at ix and strings.
363 ;; This is a helper for make-tree.
364 (define (si-map string-list ix)
365   (let iter ((sal '()) (sl string-list))
366     (cond
367      ((null? sl) sal)
368      ((= ix (string-length (car sl)))
369       (iter (reverse (acons 'else (car sl) sal)) (cdr sl)))
370      ((assq (string-ref (car sl) ix) sal) =>
371       (lambda (pair)
372         (set-cdr! pair (cons (car sl) (cdr pair)))
373         (iter sal (cdr sl))))
374      (else ;; Add (#\? . string) to alist.
375       (iter (cons (cons (string-ref (car sl) ix) (list (car sl))) sal)
376             (cdr sl))))))
377
378 ;;.@deffn make-tree strtab -> tree
379 ;; This routine takes an alist of strings and symbols and makes a tree
380 ;; that parses one char at a time and provide @code{'else} entry for
381 ;; signaling sequence found.  That is, if @code{("ab" . 1)} is an entry
382 ;; then a chseq-reader (see below) would stop at @code{"ab"} and
383 ;; return @code{1}.
384 (define (make-tree strtab)
385   (define (si-cnvt string-list ix)
386     (map (lambda (pair)
387            (if (pair? (cdr pair))
388                (cons (car pair) (si-cnvt (cdr pair) (1+ ix)))
389                (cons (car pair) (assq-ref strtab (cdr pair)))))
390          (si-map string-list ix)))
391   (si-cnvt (map car strtab) 0))
392
393 ;; @deffn make-chseq-reader strtab
394 ;; Given alist of pairs (string, token) return a function that eats chars
395 ;; until (token . string) is returned or @code{#f} if no match is found.
396 (define (make-chseq-reader strtab)
397   ;; This code works on the assumption that the else-part is always last
398   ;; in the list of transitions.
399   (let ((tree (make-tree strtab)))
400     (lambda (ch)
401       (let iter ((cl (list ch)) (node tree))
402         (cond
403          ((assq-ref node (car cl)) => ;; accept or shift next character
404           (lambda (n)
405             (if (eq? (caar n) 'else) ; if only else, accept, else read on
406                 (cons (cdar n) (lsr cl))
407                 (iter (cons (read-char) cl) n))))
408          ((assq-ref node 'else) => ; else exists, accept
409           (lambda (tok)
410             (unread-char (car cl))
411             (cons tok (lsr (cdr cl)))))
412          (else ;; reject
413           (let pushback ((cl cl))
414             (unless (null? (cdr cl))
415               (unread-char (car cl))
416               (pushback (cdr cl))))
417           #f))))))
418
419 ;; @deffn make-comm-reader comm-table [#:eat-newline #t] => \
420 ;;   ch bol -> ('$code-comm "..")|('$lone-comm "..")|#f
421 ;; comm-table is list of cons for (start . end) comment.
422 ;; e.g. ("--" . "\n") ("/*" . "*/")
423 ;; test with "/* hello **/"
424 ;; If @code{eat-newline} is specified as true then for read comments 
425 ;; ending with a newline a newline swallowed with the comment.
426 ;; Note: assumes backslash is never part of the end
427 (define* (make-comm-reader comm-table #:key (eat-newline #f))
428
429   (define (mc-read-char)
430     (let ((ch (read-char)))
431       (if (eqv? ch #\\)
432           (let ((ch (read-char)))
433             (if (eqv? ch #\newline)
434                 (read-char)
435                 (begin (unread-char ch) #\\)))
436           ch)))
437     
438   (let ((tree (make-tree comm-table)))
439     (lambda (ch bol)
440       (letrec
441           ((tval (if bol '$lone-comm '$code-comm))
442            (match-beg ;; match start of comment, return end-string
443             (lambda (cl node)
444               (cond
445                ((assq-ref node (car cl)) => ;; shift next character
446                 (lambda (n) (match-beg (cons (mc-read-char) cl) n)))
447                ((assq-ref node 'else) =>
448                 (lambda (res) (unread-char (car cl)) res)) ; yuck?
449                (else
450                 (let pushback ((cl cl))
451                   (unless (null? (cdr cl))
452                     (unread-char (car cl))
453                     (pushback (cdr cl))))
454                 #f))))
455            (find-end ;; find end of comment, return comment
456             ;; cl: comm char list; sl: shift list; il: input list;
457             ;; ps: pattern string; px: pattern index
458             (lambda (cl sl il ps px)
459               (cond
460                ((eq? px (string-length ps))
461                 (if (and (not eat-newline) (eq? #\newline (car sl)))
462                     (unread-char #\newline))
463                 (if (and (pair? cl) (eqv? (car cl) #\return)) ;; rem trailing \r 
464                     (cons tval (list->string (reverse (cdr cl))))
465                     (cons tval (list->string (reverse cl)))))
466                ((null? il) (find-end cl sl (cons (mc-read-char) il) ps px))
467                ((eof-object? (car il)) (error "open comment"))
468                ((eqv? (car il) (string-ref ps px))
469                 (find-end cl (cons (car il) sl) (cdr il) ps (1+ px)))
470                (else
471                 (let ((il1 (append-reverse sl il)))
472                   (find-end (cons (car il1) cl) '() (cdr il1) ps 0)))))))
473         (let ((ep (match-beg (list ch) tree)))
474           (if ep (find-end '() '() (list (mc-read-char)) ep 0) #f))))))
475
476 (define read-c-comm (make-comm-reader '(("/*" . "*/") ("//" . "\n"))))
477
478 ;; @deffn filter-mt p? al => al
479 ;; Filter match-table based on cars of al.
480 (define (filter-mt p? al) (filter (lambda (x) (p? (car x))) al))
481
482 ;; @deffn remove-mt p? al => al
483 ;; Remove match-table based on cars of al.
484 (define (remove-mt p? al) (remove (lambda (x) (p? (car x))) al))
485
486 ;; @deffn map-mt f al => al
487 ;; Map cars of al.
488 (define (map-mt f al) (map (lambda (x) (cons (f (car x)) (cdr x))) al))
489
490 ;; @deffn make-lexer-generator match-table => lexer-generator
491 ;; @example
492 ;; (define gen-lexer (make-lexer-generator #:ident-reader my-id-rdr))
493 ;; (with-input-from-file "foo" (parse (gen-lexer)))
494 ;; @end example
495 ;;
496 ;; Return a thunk that returns tokens.
497 ;; Change this to have user pass the following routines (optionally?)
498 ;; read-num, read-ident, read-comm
499 ;; reztab = reserved ($ident, $fixed, $float ...
500 ;; chrtab = characters
501 ;; comm-reader : if parser does not deal with comments must return #f
502 ;;               but problem with character ..
503 ;; match-table:
504 ;; @enumerate
505 ;; symbol -> (string . symbol)
506 ;; reserved -> (symbol . symbol)
507 ;; char -> (char . char)
508 ;; @end enumerate
509 ;; todo: add bol status
510 ;; todo: maybe separate reading of keywords from identifiers: (keywd ch) =>
511 (define* (make-lexer-generator match-table
512                                #:key ident-reader num-reader
513                                string-reader chlit-reader
514                                comm-reader comm-skipper
515                                space-chars)
516   (let* ((read-ident (or ident-reader (make-ident-reader c:if c:ir)))
517          (read-num (or num-reader (make-num-reader)))
518          (read-string (or string-reader (make-string-reader #\")))
519          (read-chlit (or chlit-reader (lambda (ch) #f)))
520          (read-comm (or comm-reader (lambda (ch bol) #f)))
521          (skip-comm (or comm-skipper (lambda (ch) #f)))
522          (spaces (or space-chars " \t\r\n"))
523          (space-cs (cond ((string? spaces) (string->char-set spaces))
524                          ((list? spaces) (list->char-set spaces))
525                          ((char-set? spaces) spaces)
526                          (else (error "expecting string list or char-set"))))
527          ;;
528          (ident-like? (make-ident-like-p read-ident))
529          ;;
530          (strtab (filter-mt string? match-table)) ; strings in grammar
531          (kwstab (filter-mt ident-like? strtab))  ; keyword strings =>
532          (keytab (map-mt string->symbol kwstab))  ; keywords in grammar
533          (chrseq (remove-mt ident-like? strtab))  ; character sequences
534          (symtab (filter-mt symbol? match-table)) ; symbols in grammar
535          (chrtab (filter-mt char? match-table))   ; characters in grammar
536          ;;
537          (read-chseq (make-chseq-reader chrseq))
538          (assc-$ (lambda (pair) (cons (assq-ref symtab (car pair)) (cdr pair))))
539          )
540     (lambda ()
541       (let ((bol #f))
542         (lambda ()
543           (let iter ((ch (read-char)))
544             (cond
545              ((eof-object? ch) (assc-$ (cons '$end ch)))
546              ;;((eq? ch #\newline) (set! bol #t) (iter (read-char)))
547              ((char-set-contains? space-cs ch) (iter (read-char)))
548              ((and (eqv? ch #\newline) (set! bol #t) #f))
549              ((read-comm ch bol) =>
550               (lambda (p) (set! bol #f) (assc-$ p)))
551              ((skip-comm ch) (iter (read-char)))
552              ((read-ident ch) =>
553               (lambda (s) (or (and=> (assq-ref keytab (string->symbol s))
554                                      (lambda (tval) (cons tval s)))
555                               (assc-$ (cons '$ident s)))))
556              ((read-num ch) => assc-$)    ; => $fixed or $float
557              ((read-string ch) => assc-$) ; => $string
558              ((read-chlit ch) => assc-$)  ; => $chlit
559              ((read-chseq ch) => identity)
560              ((assq-ref chrtab ch) => (lambda (t) (cons t (string ch))))
561              (else (cons ch ch))))))))) ; should be error
562
563 ;; @end table
564
565 ;; --- last line ---