(define-module esc (use gauche.regexp) (export esc-eval esc->list)) (select-module esc) ;; (define ;; ESC ;; Embedded-SCheme) (define esc-eval (lambda (esc-src . args) (letrec ( (esc->func (lambda (src) (string-append "(lambda " "(args esc-eval) " "(lambda " "() " (esc->scm src) " ))"))) (string-escape (lambda (src) (regexp-replace-all (string->regexp "\\\"") (regexp-replace-all (string->regexp "\\\\") src "\\\\\\\\") "\\\\\\\""))) (comment-escape (lambda (src) (regexp-replace-all (string->regexp "\\\|\\\#") src "\\\|\\\\\\#") )) (string-display (lambda (src use-quote) (string-append "(display " (if use-quote "\"" "") src (if use-quote "\"" "") "\n" " )" "\n"))) (esc->scm (lambda (esc-ls) (if (< (length esc-ls) 4) (string-display (string-escape (car esc-ls)) #t) (let ( (plain-part (car esc-ls)) (display-symbol (cadr esc-ls)) (code-part (caddr esc-ls))) (string-append (if (> (string-length plain-part) 0) (string-display (comment-escape (string-escape plain-part)) #t) "") (if (string=? display-symbol "=") (string-display code-part #f) code-part) "\n" (esc->scm (cdddr esc-ls))))))) (func->string (lambda (src args) (let ( (output-port (open-output-string)) (esc-func ((eval (read (open-input-string src)) (interaction-environment) ;;(make-module) ) args esc-eval))) (with-output-to-port output-port esc-func) (get-output-string output-port))))) (func->string (esc->func (esc->list esc-src)) args) ))) ;; ( ;; plain display-symbol code ;; plain display-symbol code ;; plain display-symbol code ...) ;; ;;"^(.*?)(?:\n?<%-|<%)" ;;"(=|)" ;;"(.*?)(?:-%>\n?|%>)(.*?)$" (define esc->list (lambda (src) (let* ( (inner-string "(?:[\\\\].|[^\"\\\\])*?") (inner-regexp "(?:[\\\\].|[^\/\\\\])*?") (outer "(?:[\\\\].|\;.*?|[^\"\\\\])*?") (parser-regexp (string->regexp (string-append "^(.*?)" "(?:\n?<%-|<%)" "(=|)" "(" "(?:" outer "(?:" "\"" inner-string "\"" "|" "#\/" inner-regexp "\/" ")" ")*?" outer "(?:\\\\|)" ")" "(?:-%>\n?|%>)" "(.*?)$" )))) (letrec ((esc-split (lambda (src) (let ((esc-match (rxmatch parser-regexp src))) (if (not esc-match) (list src) (cons (rxmatch-substring esc-match 1) (cons (rxmatch-substring esc-match 2) (cons (rxmatch-substring esc-match 3) (esc-split (rxmatch-substring esc-match 4)))))))))) (esc-split src))))) (provide "esc")