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

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

ersatz: further updates to new line handling in lexer logic mode

File size: 8.3 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 '("%}" "%}\n"))
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~A     (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  (cond ((string? begin-logic) 
140         (sprintf "~S" begin-logic))
141        ((pair? begin-logic) 
142         (string-join (map (lambda (s) (sprintf "~S" s)) begin-logic) "|"))
143        (else (error 'ersatz "invalid begin-logic specification" begin-logic))))
144
145  (fprintf output-port #<<EOF
146~A     (cases lexer-mode (lexer-curmode)
147              (LexerLogic ()
148                (lexer-curmode (LexerPlain))
149                (yycontinue))
150             (else (lexer-error "unexpected end of logic mode"))
151             )
152
153EOF
154  (cond ((string? end-logic) 
155         (sprintf "~S" end-logic))
156        ((pair? end-logic) 
157         (string-join (map (lambda (s) (sprintf "~S" s)) end-logic) "|"))
158        (else (error 'ersatz "invalid end-logic specification" end-logic))))
159
160
161(fprintf output-port #<<EOF
162
163"\\{" (begin
164       (display #\{ (lexer-text-buffer))
165       (yycontinue))
166
167
168"\\}" (begin
169       (display #\} (lexer-text-buffer))
170       (yycontinue))
171
172
173"\"" (cases lexer-mode (lexer-curmode)
174            (LexerPlain ()
175               (display #\" (lexer-text-buffer))
176               (yycontinue))
177            (else
178             (let loop ([cs '()])
179               (let ([c (yygetc)])
180                 (cond [(eq? 'eof c)   (lexer-error "unexpected end of string constant")]
181                       [(char=? c #\\) (let ((n (yygetc)))
182                                         (loop (cons n cs)))]
183                       [(char=? c #\") (tok yyline STRING (reverse-list->string cs)) ]
184                       [else (loop (cons c cs))])))
185             ))
186
187"\'" (cases lexer-mode (lexer-curmode)
188            (LexerPlain ()
189               (display #\' (lexer-text-buffer))
190               (yycontinue))
191            (else
192             (let loop ([cs '()])
193               (let ([c (yygetc)])
194                 (cond [(eq? 'eof c)   (lexer-error "unexpected end of string constant")]
195                       [(char=? c #\\) (let ((n (yygetc)))
196                                         (loop (cons n cs)))]
197                       [(char=? c #\') (tok yyline STRING (reverse-list->string cs)) ]
198                       [else (loop (cons c cs))])))
199             ))
200
201"\n"   (begin
202         (display #\newline (lexer-text-buffer))
203         (yycontinue))
204
205
206{intlit} (cases lexer-mode (lexer-curmode)
207                (LexerPlain ()
208                    (begin
209                      (display yytext (lexer-text-buffer))
210                      (yycontinue)))
211                (else
212                 (tok yyline INT (string->number yytext)))
213                )
214
215
216{floatlit} (cases lexer-mode (lexer-curmode)
217                  (LexerPlain ()
218                      (begin
219                        (display yytext (lexer-text-buffer))
220                        (yycontinue)))
221                  (else
222                   (let ((n (string-length yytext)))
223                     (tok yyline FLOAT (string->number
224                                        (substring yytext 0 n)))))
225                   )
226
227{identfst}{identchr}*  (cases lexer-mode (lexer-curmode)
228                              (LexerPlain ()
229                                (begin
230                                  (display yytext (lexer-text-buffer))
231                                  (yycontinue)))
232                              (else
233                               (let*
234                                   ((word (string->symbol yytext))
235                                    (t (alist-ref word lexer-keywords)))
236                                 (if t (tok yyline ,t) 
237                                     (tok yyline IDENT word))))
238                              )
239
240"."{identfst}{identchr}*  (cases lexer-mode (lexer-curmode)
241                              (LexerPlain ()
242                                (begin
243                                  (display yytext (lexer-text-buffer))
244                                  (yycontinue)))
245                              (else
246                               (let*
247                                   ((n (string-length yytext))
248                                    (word (substring yytext 1 n)))
249                                 (tok yyline DOTFIELD word))))
250
251"=="  (cases lexer-mode (lexer-curmode)
252               (LexerPlain ()
253                           (display yytext (lexer-text-buffer))
254                           (yycontinue))
255               (else
256                (tok yyline EQEQ)))
257
258"**"  (cases lexer-mode (lexer-curmode)
259               (LexerPlain ()
260                           (display yytext (lexer-text-buffer))
261                           (yycontinue))
262               (else
263                (tok yyline POWER)))
264
265"||"  (cases lexer-mode (lexer-curmode)
266               (LexerPlain ()
267                           (display yytext (lexer-text-buffer))
268                           (yycontinue))
269               (else
270                (tok yyline OR)))
271
272"&&"  (cases lexer-mode (lexer-curmode)
273               (LexerPlain ()
274                           (display yytext (lexer-text-buffer))
275                           (yycontinue))
276               (else
277                (tok yyline AND)))
278
279"!="  (cases lexer-mode (lexer-curmode)
280               (LexerPlain ()
281                           (display yytext (lexer-text-buffer))
282                           (yycontinue))
283               (else
284                (tok yyline NEQ)))
285
286.     (cases lexer-mode (lexer-curmode)
287               (LexerPlain ()
288                           (display yytext (lexer-text-buffer))
289                           (yycontinue))
290               (else
291                (let* ((word yytext)
292                       (t (find-operator word lexer-operators )))
293                  (case (car t)
294                    ((full)     (tok yyline ,(cadr t)))
295                    ((partial)  (let ((c (yygetc)))
296                                  (if (char=? c (string-ref (cadr t) 1))
297                                      (tok yyline ,(caddr t))
298                                      (begin (yyungetc)
299                                             (tok yyline IDENT (string->symbol word))
300                                      ))
301                                   ))
302                    (else (if (char-set-contains? char-set:whitespace (string-ref word 0))
303                              (yycontinue)
304                              (tok yyline IDENT (string->symbol word))))
305                    ))
306                  ))
307
308
309<<EOF>> (cases lexer-mode (lexer-curmode)
310               (LexerPlain ()
311                  (let ((text (lexer-get-text)))
312                    (if (string-null? text)
313                        '*eoi*
314                        (tok yyline TEXT text)
315                        )))
316               (else (lexer-error "unexpected end of input (lexer)")))
317EOF
318)))
319
320
Note: See TracBrowser for help on using the repository browser.