source: project/release/4/ersatz/trunk/parser.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: 9.5 KB
Line 
1;;
2;;
3;;  Parsing routines for the Ersatz template library.
4;;
5;;  Based on the Ocaml Jingoo library, which is in turn based on the
6;;  Python Jinja2 library.
7;;
8;; Copyright 2012 Ivan Raikov and the Okinawa Institute of
9;; Science and Technology.
10;;
11;; This program is free software: you can redistribute it and/or
12;; modify it under the terms of the GNU General Public License as
13;; published by the Free Software Foundation, either version 3 of the
14;; License, or (at your option) any later version.
15;;
16;; This program is distributed in the hope that it will be useful, but
17;; WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19;; General Public License for more details.
20;;
21;; A full copy of the GPL license can be found at
22;; <http://www.gnu.org/licenses/>.
23;;
24
25
26(define-syntax tok
27  (syntax-rules ()
28    ((tok ln t) (make-lexical-token (quasiquote t) ln #f))
29    ((tok ln t l) (make-lexical-token (quasiquote t) ln l))
30    ))
31
32(define keep-lexer-table (make-parameter #f))
33
34(define (make-lexer-table #!key 
35                          (begin-comment "{#")
36                          (end-comment "#}")
37                          (begin-expand "{{")
38                          (end-expand "}}")
39                          (begin-logic "{%")
40                          (end-logic "%}") 
41                          (compile #t))
42 
43  (let* ((lexer-proc (gensym 'ersatz-lexer-table))
44         (lexer-fn (->string lexer-proc))
45         (lexer-fn-scm (string-append (->string lexer-proc) ".scm"))
46         (output-port (open-output-file lexer-fn)))
47
48    (make-ersatz-lexer output-port
49                       begin-comment: begin-comment
50                       end-comment: end-comment
51                       begin-expand: begin-expand
52                       end-expand: end-expand
53                       begin-logic: begin-logic
54                       end-logic: end-logic)
55
56    (close-output-port output-port)
57
58    (lex-tables lexer-fn lexer-fn lexer-fn-scm
59                'counters 'line 'code)
60
61    (let* ((in (open-input-file lexer-fn-scm)) 
62           (contents (read in)))
63
64      (close-input-port in)
65
66      (let ((contents 
67             `(module ,lexer-proc * (import scheme chicken) 
68                      (import (only srfi-13 string-null?)
69                              (only data-structures alist-ref))
70                     
71                      (require-extension datatype lalr-driver)
72                     
73                      (define-syntax tok
74                        (syntax-rules ()
75                          ((tok ln t) (make-lexical-token (quasiquote t) ln #f))
76                          ((tok ln t l) (make-lexical-token (quasiquote t) ln l))
77                          ))
78
79                      (define-syntax lexer-yyungetcn
80                        (syntax-rules ()
81                          ((lexer-ungetcn i ungetc)
82                           (let recur ((i i))
83                             (if (positive? i)
84                                 (begin (ungetc) (recur (- i 1))))
85                             ))
86                          ))
87                     
88                     
89                      (define-syntax lexer-lookahead
90                        (syntax-rules ()
91                          ((lexer-lookahead c str n getc ungetc)
92                           (and (char=? (string-ref str 0) c)
93                                (let recur ((i 1))
94                                  (if (< i n) 
95                                      (if (char=? (string-ref str i) (getc))
96                                          (recur (+ 1 i)) 
97                                          (begin (lexer-yyungetcn i ungetc) #f))
98                                      #t))
99                                ))
100                          ))
101
102                      (define-datatype lexer-mode lexer-mode?
103                        (LexerPlain)
104                        (LexerExpand)
105                        (LexerLogic))
106
107                      (define lexer-curmode (make-parameter (LexerPlain)))
108
109                      (define lexer-text-buffer (make-parameter (open-output-string)))
110                     
111                      (define lexer-string-buffer (make-parameter (open-output-string)))
112                     
113                      (define lexer-token-cache (make-parameter '()))
114                     
115                     
116                      (define-syntax lexer-get-string
117                        (syntax-rules ()
118                          ((lexer-get-string) 
119                           (let ((str (get-output-string (lexer-string-buffer))))
120                             (close-output-port (lexer-string-buffer))
121                             (lexer-string-buffer (open-output-string))
122                             str))
123                          ))
124                     
125                     
126                      (define-syntax lexer-get-text
127                        (syntax-rules ()
128                          ((lexer-get-text) 
129                           (let ((text (get-output-string (lexer-text-buffer))))
130                             (close-output-port (lexer-text-buffer))
131                             (lexer-text-buffer (open-output-string))
132                             text))
133                          ))
134                     
135                     
136                      (define lexer-keywords
137                        '((true . TRUE)
138                          (false . FALSE)
139                          (null . NULL)
140                          (if . IF)
141                          (else . ELSE)
142                          (elseif . ELSEIF)
143                          (endif . ENDIF)
144                          (for . FOR)
145                          (endfor . ENDFOR)
146                          (include . INCLUDE)
147                          (extends . EXTENDS)
148                          (block . BLOCK)
149                          (endblock . ENDBLOCK)
150                          (filter . FILTER)
151                          (endfilter . ENDFILTER)
152                          (macro . MACRO)
153                          (endmacro . ENDMACRO)
154                          (call . CALL)
155                          (endcall . ENDCALL)
156                          (import . IMPORT)
157                          (as . AS)
158                          (from . FROM)
159                          (in . IN)
160                          (set . SET)
161                          (not . NOT)
162                          (is . IS)
163                          (with . WITH)
164                          (endwith . ENDWITH)
165                          (without . WITHOUT)
166                          (context . CONTEXT)
167                          (autoescape . AUTOESCAPE)
168                          (endautoescape . ENDAUTOESCAPE)
169                          ))
170                     
171                     
172                      (define lexer-error error)
173
174                      ,contents)))
175
176        (let ((out (open-output-file lexer-fn-scm)))
177          (pp contents out)
178          (close-output-port out))))
179
180    (if compile
181        (begin
182          (run (csc -s ,lexer-fn-scm -j ,lexer-fn))
183          (load (string-append "./" lexer-fn ".so"))
184          (load (open-input-file (string-append "./" lexer-fn ".import.scm")))
185          )
186        (load lexer-fn-scm))
187    (let ((res (eval (string->symbol (conc lexer-proc "#" lexer-proc)))))
188      (if (not (keep-lexer-table))
189          (for-each delete-file (list lexer-fn lexer-fn-scm )))
190      res
191    )))
192
193
194(define-syntax lexer-yyungetcn
195  (syntax-rules ()
196    ((lexer-ungetcn i ungetc)
197     (let recur ((i i))
198       (if (positive? i)
199           (begin (ungetc) (recur (- i 1))))
200       ))
201    ))
202
203
204(define-syntax lexer-lookahead
205  (syntax-rules ()
206    ((lexer-lookahead c str n getc ungetc)
207     (and (char=? (string-ref str 0) c)
208          (let recur ((i 1))
209            (if (< i n) 
210                (if (char=? (string-ref str i) (getc))
211                    (recur (+ 1 i)) 
212                 (begin (lexer-yyungetcn i ungetc) #f))
213                #t))
214          ))
215    ))
216       
217
218(define-datatype lexer-mode lexer-mode?
219  (LexerPlain)
220  (LexerExpand)
221  (LexerLogic))
222
223
224(define lexer-curmode (make-parameter (LexerPlain)))
225
226(define lexer-text-buffer (make-parameter (open-output-string)))
227
228(define lexer-string-buffer (make-parameter (open-output-string)))
229
230(define lexer-token-cache (make-parameter '()))
231
232
233(define-syntax lexer-get-string
234  (syntax-rules ()
235    ((lexer-get-string) 
236     (let ((str (get-output-string (lexer-string-buffer))))
237       (close-output-port (lexer-string-buffer))
238       (lexer-string-buffer (open-output-string))
239       str))
240    ))
241
242
243(define-syntax lexer-get-text
244  (syntax-rules ()
245    ((lexer-get-text) 
246     (let ((text (get-output-string (lexer-text-buffer))))
247       (close-output-port (lexer-text-buffer))
248       (lexer-text-buffer (open-output-string))
249       text))
250    ))
251
252
253(define lexer-keywords
254  '((true . TRUE)
255    (false . FALSE)
256    (null . NULL)
257    (if . IF)
258    (else . ELSE)
259    (elseif . ELSEIF)
260    (endif . ENDIF)
261    (for . FOR)
262    (endfor . ENDFOR)
263    (include . INCLUDE)
264    (extends . EXTENDS)
265    (block . BLOCK)
266    (endblock . ENDBLOCK)
267    (filter . FILTER)
268    (endfilter . ENDFILTER)
269    (macro . MACRO)
270    (endmacro . ENDMACRO)
271    (call . CALL)
272    (endcall . ENDCALL)
273    (import . IMPORT)
274    (as . AS)
275    (from . FROM)
276    (in . IN)
277    (set . SET)
278    (not . NOT)
279    (is . IS)
280    (with . WITH)
281    (endwith . ENDWITH)
282    (without . WITHOUT)
283    (context . CONTEXT)
284    (autoescape . AUTOESCAPE)
285    (endautoescape . ENDAUTOESCAPE)
286    ))
287
288
289(define lexer-error error)
290
291(include "ersatz.l.scm")
292
293(define (make-parse-error loc)
294  (lambda (msg #!optional arg)
295    (let ((loc-str (or (and loc (if (list? loc) (conc " " loc " ") (conc " (" loc ") "))) " ")))
296      (cond  [(not arg) (error loc-str msg)]
297             [(lexical-token? arg)
298              (let ((src (lexical-token-source arg))
299                    (cat (lexical-token-category arg)))
300                (error (sprintf "~Aline ~A: ~A " 
301                                loc-str
302                                (if (integer? src) src (source-location-line src)) 
303                                msg) 
304                       (or (and cat (sprintf " ~A" cat)) "")
305                       ))]
306             [else (error loc-str (conc msg arg))]
307             ))))
308
309
310(include "ersatz.grm.scm")
311
312(define (parse lexer-table is #!key (file-path #f))
313    (let ((lexer (lexer-make-lexer lexer-table is)))
314      (reset-lexer)
315      (let ((ast (reverse (parser (lambda () 
316                                   (let ((c (lexer-token-cache)))
317                                     (let ((t (if (null? c) (lexer)
318                                                  (let ((t (car c)))
319                                                    (lexer-token-cache (cdr c))
320                                                    t))))
321;                                   (if (lexical-token? t)
322;                                       (print "lexer: token = " (lexical-token-category t))
323;                                       (print "lexer: token = " t))
324                                       t)))
325                                 (make-parse-error file-path)))))
326        ast)))
327
328
329(define (get-file-path fn #!key (template-dirs '()))
330  (if (null? template-dirs)
331      (let ((file-path (make-pathname (current-directory) fn)))
332        (if (file-exists? file-path)
333            file-path
334            (error 'get-file-path "file not found" fn)))
335      (let ((dir (car template-dirs)))
336        (let ((file-path (make-pathname dir fn)))
337          (if (file-exists? file-path)
338              file-path
339              (get-file-path fn template-dirs: (cdr template-dirs)))))
340      ))
341
342
343(define (statements-from-file env fn)
344
345  (let ((fpath (get-file-path fn template-dirs: (tmpl-env-search-path env))))
346
347    (let* ((inport (if (file-exists? fpath)
348                       (open-input-file fpath)
349                       (error 'statements-from-file "input file not found " fpath)))
350           (is ;; lexer input system
351            (lexer-make-IS 'port inport)))
352     
353      (let ((stmts (parse (tmpl-env-lexer-table env) is file-path: fpath)))
354        (close-input-port inport)
355        stmts
356      ))
357    ))
358
359
360(define (statements-from-string env source #!key (file-path #f))
361
362  (let ((is ;; lexer input system
363         (if (string? source)
364             (lexer-make-IS 'string source)
365             (error 'statements-from-string "bad argument type; not a string" source))
366         ))
367
368    (parse (tmpl-env-lexer-table env) is file-path: file-path)
369
370    ))
371
372
373(define (reset-lexer)
374  (lexer-text-buffer (open-output-string))
375  (lexer-string-buffer (open-output-string))
376  (lexer-curmode (LexerPlain))
377  (lexer-token-cache '()))
Note: See TracBrowser for help on using the repository browser.