Changeset 26863 in project


Ignore:
Timestamp:
06/08/12 10:09:03 (9 years ago)
Author:
Ivan Raikov
Message:

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

Location:
release/4/ersatz/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/ersatz/trunk/ersatz-lib.scm

    r26859 r26863  
    3030         template-std-env init-context
    3131
    32          template-environment? make-template-environment
     32         template-environment? make-template-environment make-lexer-table keep-lexer-table
    3333         tmpl-env-autoescape tmpl-env-search-path tmpl-env-filters tmpl-env-lexer-table
    3434         template-context? make-template-context
     
    6767                (only posix current-directory)
    6868                (only files make-pathname)
    69                 (only extras fprintf sprintf)
    70                 (only utils read-all))
     69                (only extras fprintf sprintf pp)
     70                (only utils read-all)
     71                )
    7172
    7273        (require-extension datatype lalr lalr-driver uri-generic)
    73         (require-library utf8 utf8-srfi-13 utf8-srfi-14 silex)
     74        (require-library setup-api utf8 utf8-srfi-13 utf8-srfi-14 silex)
    7475       
    7576        (import (only utf8 string-length substring)
     
    8081                      char-set char-set->string)
    8182                (only silex lex-tables lexer-make-IS lexer-make-lexer )
     83                (only setup-api run execute)
    8284                )
    8385
     
    407409
    408410
    409 
     411(include "make-ersatz-lexer.scm")
    410412(include "parser.scm")
    411413(include "eval.scm")
  • release/4/ersatz/trunk/make-ersatz-lexer.scm

    r26862 r26863  
    3434                           (end-expand "}}")
    3535                           (begin-logic "{%")
    36                            (end-logic "%}") )
     36                           (end-logic "%}")
     37                           )
    3738
    3839  (let ((begin-comment-len (string-length begin-comment))
  • release/4/ersatz/trunk/parser.scm

    r26862 r26863  
    2929    ((tok ln t l) (make-lexical-token (quasiquote t) ln l))
    3030    ))
     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    )))
    31192
    32193
  • release/4/ersatz/trunk/tests/run.scm

    r26859 r26863  
    355355         (Tstr "test")))
    356356
     357   (test-assert "make-lexer-table"
     358               (let* ((lexer-table (make-lexer-table begin-expand: "%{{" end-expand: "%}}" compile: #f))
     359                      (env (template-std-env lexer-table: lexer-table))
     360                      (script "<script>alert(1)</script>")
     361                      (output (from-string "%{{danger%}}"
     362                                           env: env
     363                                           models: (list (cons 'danger (Tstr script)))))
     364                      )
     365                 (tval-equal? (Tstr output) (op-escape-html (Tstr script) kwargs))))
     366
     367   (test-assert "make-lexer-table (compiled)"
     368               (let* ((lexer-table (make-lexer-table begin-expand: "%{{" end-expand: "%}}" compile: #t))
     369                      (env (template-std-env lexer-table: lexer-table))
     370                      (script "<script>alert(1)</script>")
     371                      (output (from-string "%{{danger%}}"
     372                                           env: env
     373                                           models: (list (cons 'danger (Tstr script)))))
     374                      )
     375                 (tval-equal? (Tstr output) (op-escape-html (Tstr script) kwargs))))
     376
    357377     
    358378)
    359 (let* ((script "<script>alert(1)</script>")
    360                       (output (from-string "{{danger}}"
    361                                            models: (list (cons 'danger (Tstr script)))))
    362                       )
    363   (print output))
Note: See TracChangeset for help on using the changeset viewer.