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

Last change on this file since 26863 was 26863, checked in by Ivan Raikov, 9 years ago

ersatz: implement a procedure for easy creation of custom lexers and added tests

File size: 6.1 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 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(define (make-ersatz-lexer output-port
30                           #!key 
31                           (begin-comment "{#")
32                           (end-comment "#}")
33                           (begin-expand "{{")
34                           (end-expand "}}")
35                           (begin-logic "{%")
36                           (end-logic "%}") 
37                           )
38
39  (let ((begin-comment-len (string-length begin-comment))
40        (end-comment-len (string-length end-comment)))
41
42  (fprintf output-port #<<EOF
43blank    [\9\32]
44identfst [A-Za-z]
45identchr [A-Za-z0-9_]
46intlit   [0-9][0-9]*
47floatlit [0-9]+(\.[0-9]*)?([eE][-+]?[0-9]+)?
48
49%%
50
51
52EOF
53)
54
55
56  (fprintf output-port #<<EOF
57~S       (let ((start ~S) (end ~S))
58                (cases lexer-mode (lexer-curmode)
59                      (LexerPlain ()
60                            (let loop ((kont yycontinue))
61                              (let ((c (yygetc)))
62                                (cond ((eq? 'eof c) 
63                                       (lexer-error "unexpected end of comment"))
64                                      ((lexer-lookahead c end ~A yygetc yyungetc)
65                                       (kont))
66                                      ((lexer-lookahead c start ~A yygetc yyungetc)
67                                       (loop loop))
68                                      (else (loop kont))
69                                      ))
70                              ))
71                        (else
72                         (lexer-error "unexpected comment"))))
73
74EOF
75   begin-comment 
76   begin-comment end-comment
77   (- begin-comment-len 1)
78   (- end-comment-len 1))
79
80
81  (fprintf output-port #<<EOF
82~S   (cases lexer-mode (lexer-curmode)
83            (LexerPlain ()
84                (lexer-curmode (LexerExpand))
85                (let ((text (lexer-get-text)))
86                  (if (string-null? text)
87                      (tok yyline EXPAND)
88                      (begin
89                        (lexer-token-cache (cons (tok yyline EXPAND) (lexer-token-cache)))
90                        (tok yyline TEXT text)
91                        ))
92                  ))
93             (else
94              (lexer-error "unexpected expansion"))
95             )
96
97EOF
98  begin-expand)
99
100  (fprintf output-port #<<EOF
101~S   (cases lexer-mode (lexer-curmode)
102            (LexerExpand ()
103                (lexer-curmode (LexerPlain))
104                (tok yyline ENDEXPAND))
105             (else
106              (lexer-error "unexpected end of expansion"))
107             )
108
109EOF
110   end-expand)
111
112  (fprintf output-port #<<EOF
113~S     (cases lexer-mode (lexer-curmode)
114              (LexerPlain ()
115                 (let ((text (lexer-get-text)))
116                   (lexer-curmode (LexerLogic))
117                   (if (string-null? text)
118                       (yycontinue)
119                       (tok yyline TEXT text))))
120             (else
121              (lexer-error "unexpected logic mode"))
122             )
123
124EOF
125   begin-logic)
126
127  (fprintf output-port #<<EOF
128~S     (cases lexer-mode (lexer-curmode)
129              (LexerLogic ()
130                (lexer-curmode (LexerPlain))
131                (yycontinue))
132             (else (lexer-error "unexpected end of logic mode"))
133             )
134
135EOF
136    end-logic)
137
138(fprintf output-port #<<EOF
139
140"\\{" (begin
141       (display #\{ (lexer-text-buffer))
142       (yycontinue))
143
144
145"\\}" (begin
146       (display #\} (lexer-text-buffer))
147       (yycontinue))
148
149
150"\"" (cases lexer-mode (lexer-curmode)
151            (LexerPlain ()
152               (display #\" (lexer-text-buffer))
153               (yycontinue))
154            (else
155             (let loop ([cs '()])
156               (let ([c (yygetc)])
157                 (cond [(eq? 'eof c)   (lexer-error "unexpected end of string constant")]
158                       [(char=? c #\\) (let ((n (yygetc)))
159                                         (loop (cons n cs)))]
160                       [(char=? c #\") (tok yyline STRING (reverse-list->string cs)) ]
161                       [else (loop (cons c cs))])))
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"\n"   (begin
179         (display #\newline (lexer-text-buffer))
180         (yycontinue))
181
182
183{intlit} (cases lexer-mode (lexer-curmode)
184                (LexerPlain ()
185                    (begin
186                      (display yytext (lexer-text-buffer))
187                      (yycontinue)))
188                (else
189                 (tok yyline INT (string->number yytext)))
190                )
191
192
193{floatlit} (cases lexer-mode (lexer-curmode)
194                  (LexerPlain ()
195                      (begin
196                        (display yytext (lexer-text-buffer))
197                        (yycontinue)))
198                  (else
199                   (let ((n (string-length yytext)))
200                     (tok yyline FLOAT (string->number
201                                        (substring yytext 0 (- n 1)))))
202                   ))
203
204       
205","  (tok yyline COMMA)
206"==" (tok yyline EQ_EQ)
207"!=" (tok yyline NEQ)
208"<=" (tok yyline LT_EQ)
209">=" (tok yyline GT_EQ)
210"&&" (tok yyline AND)
211"||" (tok yyline OR)
212"="  (tok yyline EQ)
213"<"  (tok yyline LT)
214">"  (tok yyline GT)
215"!"  (tok yyline NOT)
216"."  (tok yyline DOT)
217"+"  (tok yyline PLUS)
218"-"  (tok yyline MINUS)
219"**" (tok yyline POWER)
220"*"  (tok yyline TIMES)
221"/"  (tok yyline DIV)
222"%"  (tok yyline MOD)
223"("  (tok yyline LPAREN)
224")"  (tok yyline RPAREN)
225"["  (tok yyline LBRACKET)
226"]"  (tok yyline RBRACKET)
227"{"  (tok yyline LBRACE)
228"}"  (tok yyline RBRACE)
229":"  (tok yyline COLON)
230"|"  (tok yyline VLINE)
231
232{identfst}{identchr}*  (cases lexer-mode (lexer-curmode)
233                              (LexerPlain ()
234                                (begin
235                                  (display yytext (lexer-text-buffer))
236                                  (yycontinue)))
237                              (else
238                               (let*
239                                   ((word (string->symbol yytext))
240                                    (t (alist-ref word lexer-keywords)))
241                                 (if t (tok yyline ,t) 
242                                     (tok yyline IDENT word))))
243                              )
244
245.     (cases lexer-mode (lexer-curmode)
246               (LexerPlain ()
247                           (display yytext (lexer-text-buffer))
248                           (yycontinue))
249               (else (yycontinue)))
250
251
252<<EOF>> (cases lexer-mode (lexer-curmode)
253               (LexerPlain ()
254                  (let ((text (lexer-get-text)))
255                    (if (string-null? text)
256                        '*eoi*
257                        (tok yyline TEXT text)
258                        )))
259               (else (lexer-error "unexpected end of input")))
260EOF
261)))
262
263
Note: See TracBrowser for help on using the repository browser.