source: project/release/4/ersatz/trunk/make-ersatz-lexer.scm @ 31396

Last change on this file since 31396 was 31396, checked in by Ivan Raikov, 5 years ago

ersatz: implemented better control of whether to include new lines after logic and expansion stmts

File size: 7.8 KB
Line 
1;; -*- Hen -*-
2;;
3;; The lexical analyzer for Ersatz.
4;;
5;; Based on the Jingoo library by Masaki WATANABE.
6;;
7;; Copyright 2012-2014 Ivan Raikov and the Okinawa Institute of
8;; Science and Technology.
9;;
10;; This program is free software: you can redistribute it and/or
11;; modify it under the terms of the GNU General Public License as
12;; published by the Free Software Foundation, either version 3 of the
13;; License, or (at your option) any later version.
14;;
15;; This program is distributed in the hope that it will be useful, but
16;; WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18;; General Public License for more details.
19;;
20;; A full copy of the GPL license can be found at
21;; <http://www.gnu.org/licenses/>.
22;;
23
24;;
25;; This procedure generates a textual lexer description in the format
26;; required by SILex.
27;;
28
29(use srfi-13)
30
31(define (make-ersatz-lexer output-port
32                           #!key 
33                           (begin-comment "{#")
34                           (end-comment "#}")
35                           (begin-expand "{{")
36                           (end-expand '("}}" "}}\n"))
37                           (begin-logic "{%")
38                           (end-logic "%}") 
39                           )
40
41  (let ((begin-comment-len (string-length begin-comment))
42        (end-comment-len (string-length end-comment)))
43
44  (fprintf output-port #<<EOF
45blank    [\9\32]
46identfst [A-Za-z]
47identchr [A-Za-z0-9_]
48intlit   -?[0-9][0-9]*
49floatlit -?[0-9]+(\.[0-9]*)?([eE][-+]?[0-9]+)?
50
51
52
53%%
54
55
56EOF
57)
58
59
60  (fprintf output-port #<<EOF
61~S       (let ((start ~S) (end ~S))
62                (cases lexer-mode (lexer-curmode)
63                      (LexerPlain ()
64                            (let loop ((kont yycontinue)
65                                       (depth 1))
66                              (let ((c (yygetc)))
67                                (cond ((eq? 'eof c) 
68                                       (lexer-error "unexpected end of comment"))
69                                      ((lexer-lookahead c end ~A yygetc yyungetc)
70                                       (kont))
71                                      ((lexer-lookahead c start ~A yygetc yyungetc)
72                                       (loop (lambda () (loop kont depth)) (+ 1 depth)))
73                                      (else (loop kont depth))
74                                      ))
75                              ))
76                        (else
77                         (lexer-error "unexpected comment"))))
78
79EOF
80   begin-comment 
81   begin-comment 
82   end-comment
83   begin-comment-len
84   end-comment-len)
85
86
87  (fprintf output-port #<<EOF
88~A   (cases lexer-mode (lexer-curmode)
89            (LexerPlain ()
90                (lexer-curmode (LexerExpand))
91                (let ((text (lexer-get-text)))
92                  (if (string-null? text)
93                      (tok yyline EXPAND)
94                      (begin
95                        (lexer-token-cache (cons (tok yyline EXPAND) (lexer-token-cache)))
96                        (tok yyline TEXT text)
97                        ))
98                  ))
99             (else
100              (lexer-error "unexpected expansion"))
101             )
102
103EOF
104  (cond ((string? begin-expand) 
105         (sprintf "~S" begin-expand))
106        ((pair? begin-expand) 
107         (string-join (map (lambda (s) (sprintf "~S" s)) begin-expand) "|"))
108        (else (error 'ersatz "invalid begin-expand specification" begin-expand))))
109
110  (fprintf output-port #<<EOF
111~A   (cases lexer-mode (lexer-curmode)
112            (LexerExpand ()
113                (lexer-curmode (LexerPlain))
114                (tok yyline ENDEXPAND))
115             (else
116              (lexer-error "unexpected end of expansion"))
117             )
118
119EOF
120  (cond ((string? end-expand) 
121         (sprintf "~S" end-expand))
122        ((pair? end-expand) 
123         (string-join (map (lambda (s) (sprintf "~S" s)) end-expand) "|"))
124        (else (error 'ersatz "invalid end-expand specification" end-expand))))
125
126  (fprintf output-port #<<EOF
127~S     (cases lexer-mode (lexer-curmode)
128              (LexerPlain ()
129                 (let ((text (lexer-get-text)))
130                   (lexer-curmode (LexerLogic))
131                   (if (string-null? text)
132                       (yycontinue)
133                       (tok yyline TEXT text))))
134             (else
135              (lexer-error "unexpected logic mode"))
136             )
137
138EOF
139   begin-logic)
140
141  (fprintf output-port #<<EOF
142~S     (cases lexer-mode (lexer-curmode)
143              (LexerLogic ()
144                (lexer-curmode (LexerPlain))
145                (yycontinue))
146             (else (lexer-error "unexpected end of logic mode"))
147             )
148
149EOF
150    end-logic)
151
152(fprintf output-port #<<EOF
153
154"\\{" (begin
155       (display #\{ (lexer-text-buffer))
156       (yycontinue))
157
158
159"\\}" (begin
160       (display #\} (lexer-text-buffer))
161       (yycontinue))
162
163
164"\"" (cases lexer-mode (lexer-curmode)
165            (LexerPlain ()
166               (display #\" (lexer-text-buffer))
167               (yycontinue))
168            (else
169             (let loop ([cs '()])
170               (let ([c (yygetc)])
171                 (cond [(eq? 'eof c)   (lexer-error "unexpected end of string constant")]
172                       [(char=? c #\\) (let ((n (yygetc)))
173                                         (loop (cons n cs)))]
174                       [(char=? c #\") (tok yyline STRING (reverse-list->string cs)) ]
175                       [else (loop (cons c cs))])))
176             ))
177
178"\'" (cases lexer-mode (lexer-curmode)
179            (LexerPlain ()
180               (display #\' (lexer-text-buffer))
181               (yycontinue))
182            (else
183             (let loop ([cs '()])
184               (let ([c (yygetc)])
185                 (cond [(eq? 'eof c)   (lexer-error "unexpected end of string constant")]
186                       [(char=? c #\\) (let ((n (yygetc)))
187                                         (loop (cons n cs)))]
188                       [(char=? c #\') (tok yyline STRING (reverse-list->string cs)) ]
189                       [else (loop (cons c cs))])))
190             ))
191
192"\n"   (begin
193         (display #\newline (lexer-text-buffer))
194         (yycontinue))
195
196
197{intlit} (cases lexer-mode (lexer-curmode)
198                (LexerPlain ()
199                    (begin
200                      (display yytext (lexer-text-buffer))
201                      (yycontinue)))
202                (else
203                 (tok yyline INT (string->number yytext)))
204                )
205
206
207{floatlit} (cases lexer-mode (lexer-curmode)
208                  (LexerPlain ()
209                      (begin
210                        (display yytext (lexer-text-buffer))
211                        (yycontinue)))
212                  (else
213                   (let ((n (string-length yytext)))
214                     (tok yyline FLOAT (string->number
215                                        (substring yytext 0 n)))))
216                   )
217
218{identfst}{identchr}*  (cases lexer-mode (lexer-curmode)
219                              (LexerPlain ()
220                                (begin
221                                  (display yytext (lexer-text-buffer))
222                                  (yycontinue)))
223                              (else
224                               (let*
225                                   ((word (string->symbol yytext))
226                                    (t (alist-ref word lexer-keywords)))
227                                 (if t (tok yyline ,t) 
228                                     (tok yyline IDENT word))))
229                              )
230
231"."{identfst}{identchr}*  (cases lexer-mode (lexer-curmode)
232                              (LexerPlain ()
233                                (begin
234                                  (display yytext (lexer-text-buffer))
235                                  (yycontinue)))
236                              (else
237                               (let*
238                                   ((n (string-length yytext))
239                                    (word (substring yytext 1 n)))
240                                 (tok yyline DOTFIELD word))))
241
242"=="  (cases lexer-mode (lexer-curmode)
243               (LexerPlain ()
244                           (display yytext (lexer-text-buffer))
245                           (yycontinue))
246               (else
247                (tok yyline EQEQ)))
248
249"**"  (cases lexer-mode (lexer-curmode)
250               (LexerPlain ()
251                           (display yytext (lexer-text-buffer))
252                           (yycontinue))
253               (else
254                (tok yyline POWER)))
255
256"||"  (cases lexer-mode (lexer-curmode)
257               (LexerPlain ()
258                           (display yytext (lexer-text-buffer))
259                           (yycontinue))
260               (else
261                (tok yyline OR)))
262
263"&&"  (cases lexer-mode (lexer-curmode)
264               (LexerPlain ()
265                           (display yytext (lexer-text-buffer))
266                           (yycontinue))
267               (else
268                (tok yyline AND)))
269
270"!="  (cases lexer-mode (lexer-curmode)
271               (LexerPlain ()
272                           (display yytext (lexer-text-buffer))
273                           (yycontinue))
274               (else
275                (tok yyline NEQ)))
276
277.     (cases lexer-mode (lexer-curmode)
278               (LexerPlain ()
279                           (display yytext (lexer-text-buffer))
280                           (yycontinue))
281               (else
282                (let* ((word yytext)
283                       (t (find-operator word lexer-operators )))
284                  (case (car t)
285                    ((full)     (tok yyline ,(cadr t)))
286                    ((partial)  (let ((c (yygetc)))
287                                  (if (char=? c (string-ref (cadr t) 1))
288                                      (tok yyline ,(caddr t))
289                                      (begin (yyungetc)
290                                             (tok yyline IDENT (string->symbol word))
291                                      ))
292                                   ))
293                    (else (if (char-set-contains? char-set:whitespace (string-ref word 0))
294                              (yycontinue)
295                              (tok yyline IDENT (string->symbol word))))
296                    ))
297                  ))
298
299
300<<EOF>> (cases lexer-mode (lexer-curmode)
301               (LexerPlain ()
302                  (let ((text (lexer-get-text)))
303                    (if (string-null? text)
304                        '*eoi*
305                        (tok yyline TEXT text)
306                        )))
307               (else (lexer-error "unexpected end of input (lexer)")))
308EOF
309)))
310
311
Note: See TracBrowser for help on using the repository browser.