forked from alex-eg/sex
alex-eg
37a252f2b1
No more unquotes to instantiate templates. Also no need to pass quoted substitution lists, just use them as regular lisp macros.
67 lines
2.1 KiB
Scheme
67 lines
2.1 KiB
Scheme
(declare (unit templates))
|
|
|
|
(import
|
|
(chicken plist)
|
|
brev-separate
|
|
fmt
|
|
regex
|
|
srfi-1 ; list routines
|
|
tree)
|
|
|
|
(define (register-template name)
|
|
(put! name 'sex-template #t))
|
|
|
|
(define-syntax template
|
|
(syntax-rules ()
|
|
((template (name . args) . body)
|
|
(begin
|
|
(register-template 'name)
|
|
(define-syntax name
|
|
(syntax-rules ()
|
|
((name . applied-args)
|
|
(let* ((subst-alist (map cons 'args 'applied-args))
|
|
(replaced-body (apply-substitution `body subst-alist)))
|
|
replaced-body))))))))
|
|
|
|
(define (apply-symbol-substitution sym subst-alist)
|
|
;; All non-symbol substitutions will be filtered.
|
|
;; E.g. if the subst-alist is ((T + 1 2) (U . w) (W . e)),
|
|
;; only ((U . w) (W . e)) will be applied to symbols.
|
|
(let ((str (symbol->string sym))
|
|
(subst-map (map (fn
|
|
(if (symbol? (car x))
|
|
(cons
|
|
(fmt #f "([^\\-]?)"
|
|
(regexp-escape (symbol->string (car x)))
|
|
"([\\-$]?)")
|
|
(fmt #f "\\1" (symbol->string (cdr x)) "\\2"))
|
|
x))
|
|
(filter (fn (symbol? (cdr x))) subst-alist))))
|
|
(string->symbol
|
|
(string-substitute* str subst-map))))
|
|
|
|
(define (maybe-replace-symbol sym subst-alist)
|
|
(call/cc
|
|
(lambda (return)
|
|
(for-each (fn (when (eq? (car x) sym)
|
|
(return (cdr x))))
|
|
subst-alist)
|
|
(return sym))))
|
|
|
|
(define (apply-substitution target subst-alist)
|
|
;; Subsitute free symbols and -/$/^ separated parts
|
|
;; of symbols with provided forms.
|
|
;; E.g. with substitution (T int):
|
|
;; list-T -> list-int ; by apply-symbol-substitution
|
|
;; (var T data) -> (var int data) ; by maybe-replace-symbol
|
|
;; see respective functions for further details.
|
|
(tree-map
|
|
(fn
|
|
(if (symbol? x)
|
|
(let ((st (maybe-replace-symbol x subst-alist)))
|
|
(if (eq? st x)
|
|
(apply-symbol-substitution x subst-alist)
|
|
st))
|
|
x))
|
|
target))
|