From 37a252f2b12b841243993d0cdc084e0d77a59bb2 Mon Sep 17 00:00:00 2001 From: alex-eg Date: Fri, 11 Jul 2025 18:27:50 +0300 Subject: [PATCH] Make Sex templates more pleasant syntactically No more unquotes to instantiate templates. Also no need to pass quoted substitution lists, just use them as regular lisp macros. --- Readme.org | 58 +++++++++++++++++++++---------------------- example/list.seh | 30 +++++++++++----------- example/test-list.sex | 32 +++++++++++++++++++----- sexc.scm | 37 +++++++++++++++++++-------- templates.scm | 33 ++++++++++++++++-------- 5 files changed, 118 insertions(+), 72 deletions(-) diff --git a/Readme.org b/Readme.org index 5bf3f23..7f47040 100644 --- a/Readme.org +++ b/Readme.org @@ -90,32 +90,31 @@ struct foo { }; #+end_src -** Templating (and Chickening) +** Syntactic templates Sex has support for template substitutions. Any piece of code can be -templated. After declaring, templates should be instanced in order to -be used. To instance template, use ~,~-prefixed form in Sex -code. During instancing, template arguments in the body get -replaced with provided values by the following rules: +templated. Template declarations look like functions: they have a +name, an argument list and a body. When declared template is +encountered during reading of Sex code, its body will udergo syntactic +rewriting using the provided values by the following rules: 1. If the value is a symbol, all arguments in a body are replaced with the value, and also all /parts/ of any other symbol equal to the value also get replaced. 2. If the value is a non-symbolic form, all arguments in a body are replaced with it, but no symbolic substitution is performed. -In general, the form of a template declaration is like this: +Formally, template declaration has the following syntax: #+begin_src -(template (name (substitute-args ...) other-args ...) - body ...) +(template (name . substitute-args) . body) #+end_src *** Examples: **** Structure with templated value type #+begin_src -(template (foo (T)) - (struct foo-T - ((T value)))) +(template (foo ?T) + (struct foo-?T + ((?T value)))) -,(foo '(float)) +(foo float) #+end_src -> #+begin_src @@ -126,17 +125,20 @@ struct foo_float { }; #+end_src +Note that ~?~ at the start of template argument is not syntax, just +convention. + **** Wrapper for checking return codes #+begin_src -(template (check-sdl-return (call message ret-code)) +(template (check-sdl-return call message ret-code) (if (< 0 call) (begin (puts message) (return ret-code)))) (fn int init () - ,(check-sdl-return - '((SDL-Init SDL-INIT-VIDEO) "Failed to initialize SDL" 1)) + (check-sdl-return + (SDL-Init SDL-INIT-VIDEO) "Failed to initialize SDL" 1) ...) #+end_src -> @@ -152,23 +154,23 @@ static int init () { **** A bit of everything #+begin_src -(template (list-T (T)) - (struct list-T - ((T value) - ((* list-T) next)))) +(template (list-T ?T) + (struct list-?T + ((?T value) + ((* list-?T) next)))) -(template (list-for-each (what-do type list-var elt-var)) +(template (list-for-each type list-var elt-var body) (var type elt-var (-> list-var value)) (while (!= (-> list-var next) NULL) - what-do + body (= list-var (-> list-var next)) (= elt-var (-> list-var value)))) ; ... somewhere later -,(list-T '(int)) +(list-T int) -(pub fn void print-list (const list-int *l) - ,(list-for-each '((printf "%d " v) int l v)) +(pub fn void print-list (((const list-int) *l)) + (list-for-each int l v (printf "%d " v)) (printf "\n")) #+end_src Then will be expanded in the following code: @@ -177,7 +179,7 @@ Then will be expanded in the following code: (struct list_int ((int value) ((* list_int) next))) (%fun void print_list - (const list_int *l) + (((const list_int) *l)) (%var int v (-> l value)) (while (!= (-> l next) NULL) (printf "%d " v) @@ -195,7 +197,7 @@ struct list_int { list_int *next; }; -void print_list (int const, int list_int, int *l) { +void print_list (const list_int *l) { int v = l->value; while (l->next != NULL) { printf("%d ", v); @@ -206,10 +208,6 @@ void print_list (int const, int list_int, int *l) { } #+end_src -Also, as a bonus, not only a template can be used after ~,~ in Sex -source, but in fact any Chicken code you want to run during the -transpilation. - ** Use an established environment for development As Sex is S-expressions, you always have Emacs with paredit as your best option. diff --git a/example/list.seh b/example/list.seh index 58b053e..8b445c0 100644 --- a/example/list.seh +++ b/example/list.seh @@ -1,34 +1,34 @@ -(template (list-T (T)) - (struct list-T - ((T value) - ((* list-T) next)))) +(template (list-T ?T) + (struct list-?T + ((?T value) + ((* list-?T) next)))) -(template (make-list-T (T) is-public?) - (,@(if is-public? '(pub) '()) fn (* list-T) make-list-T () - (var (* list-T) list (cast (* list-T) (malloc (sizeof list-T)))) +(template (make-list-T ?T is-public?) + (,@(if 'is-public? '(pub) '()) fn (* list-?T) make-list-?T () + (var (* list-?T) list (cast (* list-?T) (malloc (sizeof list-?T)))) (= (-> list next) NULL) list)) -(template (add-value-list-T (T) is-public?) - (,@(if is-public? '(pub) '()) fn void add-value-list-T ((list-T *list) (T value)) +(template (add-value-list-?T ?T is-public?) + (,@(if 'is-public? '(pub) '()) fn void add-value-list-?T ((list-?T *list) (T value)) (while (!= (-> list next) NULL) (= list (-> list next))) - (= (-> list next) (make-list-T)) + (= (-> list next) (make-list-?T)) (= (-> list value) value))) -(template (length-list-T (T) is-public?) - (,@(if is-public? '(pub) '()) fn size-t length-list-T ((list-T *list)) +(template (length-list-?T ?T is-public?) + (,@(if 'is-public? '(pub) '()) fn size-t length-list-?T ((list-?T *list)) (var size-t n 0) (while (!= (-> list next) NULL) (= list (-> list next)) (++ n)) n)) -(template (is-empty-list-T (T) is-public?) - (,@(if is-public? '(pub) '()) fn bool is-empty-list-T ((list-T *list)) +(template (is-empty-list-?T ?T is-public?) + (,@(if 'is-public? '(pub) '()) fn bool is-empty-list-?T ((list-?T *list)) (== (-> list next) NULL))) -(template (list-for-each (what-do list-var elt-var)) +(template (list-for-each list-var elt-var what-do) (var int elt-var (-> list-var value)) (while (!= (-> list-var next) NULL) what-do diff --git a/example/test-list.sex b/example/test-list.sex index 1bf62af..73bfdfc 100644 --- a/example/test-list.sex +++ b/example/test-list.sex @@ -18,11 +18,11 @@ (var foo f #((= .a-field 1.2))) -,(list-T '(int)) -,(make-list-T '(int) #f) -,(add-value-list-T '(int) #f) -,(length-list-T '(int) #f) -,(is-empty-list-T '(int) #f) +(list-T int) +(make-list-T int) +(add-value-list-T int) +(length-list-T int) +(is-empty-list-T int) (extern fn void puk ((int a) (float b))) (fn int bar () ,(imports-test 10 20 30)) @@ -38,7 +38,8 @@ (add-value-list-int l 3) (add-value-list-int l 4) (printf "Size of the list: %zu\n" (length-list-int l)) - ,(list-for-each '((printf "%d " v) l v)) + (list-for-each l v + (printf "%d " v)) (printf "\n") (printf "%zu\n" l->next) 0) @@ -47,3 +48,22 @@ (pub fn void clear-command-buffer ((segs-renderer *r))) (pub fn void add-render-command ((segs-renderer *r) ((fn void ()) command))) (pub fn void commit-command-buffer ((segs-renderer *r))) + +(template (list-T ?T) + (struct list-?T + ((?T value) + ((* list-?T) next)))) + +(template (list-for-each type list-var elt-var body) + (var type elt-var (-> list-var value)) + (while (!= (-> list-var next) NULL) + body + (= list-var (-> list-var next)) + (= elt-var (-> list-var value)))) + +; ... somewhere later +(list-T int) + +(pub fn void print-list (((const list-int) *l)) + (list-for-each int l v (printf "%d " v)) + (printf "\n")) diff --git a/sexc.scm b/sexc.scm index 08fe674..d867f57 100644 --- a/sexc.scm +++ b/sexc.scm @@ -3,6 +3,7 @@ (import brev-separate (chicken pathname) + (chicken plist) (chicken pretty-print) (chicken process-context) (chicken string) @@ -83,6 +84,14 @@ (char=? #\. (string-ref (symbol->string (car form)) 0))) (cons (make-field-access form) acc)) + ;; another special case - template + ((template? form) + (append (fold + walk-generic + (list) + (eval form)) + acc)) + ;; toplevel, or a start of a regular list form (else (let ((new-acc (list))) @@ -134,18 +143,26 @@ (append (walk-generic (list 'static (cdr form)) (list)) acc)) (else (error "Pub what?")))) +(define (template? form) + (and (list? form) + (symbol? (car form)) + (get (car form) 'sex-template))) + (define (walk-sex-tree form acc) (if (list? form) - (case (car form) - ((fn) (walk-function form #t acc)) - ((extern) (walk-extern form acc)) - ((pub) (walk-public form acc)) - ((struct union) (walk-struct form acc)) - ((unquote) (fold (fn (walk-sex-tree x y)) - acc - (eval (cadr form)))) - - (else (append (walk-generic form (list)) acc))) + (if (template? form) + (fold (fn (walk-sex-tree x y)) + acc + (eval form)) + (case (car form) + ((fn) (walk-function form #t acc)) + ((extern) (walk-extern form acc)) + ((pub) (walk-public form acc)) + ((struct union) (walk-struct form acc)) + ((unquote) (fold (fn (walk-sex-tree x y)) + acc + (eval (cadr form)))) + (else (append (walk-generic form (list)) acc)))) ;; only for unquote support (list (list (atom-to-fmt-c form))))) diff --git a/templates.scm b/templates.scm index e36e4e3..4510a12 100644 --- a/templates.scm +++ b/templates.scm @@ -1,18 +1,27 @@ (declare (unit templates)) -(import brev-separate - fmt - regex - srfi-1 ; list routines - tree) +(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 () - ((_ (name subst-list args ...) body ...) - (define (name subst-list-arg args ...) - (let* ((subst-alist (map cons 'subst-list subst-list-arg)) - (replaced-body (apply-substitution `(body ...) subst-alist))) - replaced-body))))) + ((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. @@ -22,7 +31,9 @@ (subst-map (map (fn (if (symbol? (car x)) (cons - (fmt #f "([^\\-]?)" (symbol->string (car x)) "([\\-$]?)") + (fmt #f "([^\\-]?)" + (regexp-escape (symbol->string (car x))) + "([\\-$]?)") (fmt #f "\\1" (symbol->string (cdr x)) "\\2")) x)) (filter (fn (symbol? (cdr x))) subst-alist))))