alex-eg/sex
1
0
Fork 1
Code Issues 3 Pull Requests 1 Actions Packages Projects 1 Releases Wiki Activity

Make Sex templates more pleasant syntactically

Browse Source 
No more unquotes to instantiate templates.
Also no need to pass quoted substitution lists, just use them as
regular lisp macros.
This commit is contained in:
alex-eg
2025-07-11 18:27:50 +03:00
parent c084eaa397
commit 76ca609ea6
5 changed files with 118 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
Readme.org
View File

@@ -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.

30
example/list.seh
View File

@@ -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

32
example/test-list.sex
View File

@@ -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"))

21
sexc.scm
View File

@@ -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,8 +143,17 @@
(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)
(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))
@@ -144,8 +162,7 @@
((unquote) (fold (fn (walk-sex-tree x y))
acc
(eval (cadr form))))
(else (append (walk-generic form (list)) acc)))
(else (append (walk-generic form (list)) acc))))
;; only for unquote support
(list (list (atom-to-fmt-c form)))))

25
templates.scm
View File

@@ -1,18 +1,27 @@
(declare (unit templates))
(import brev-separate
(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))))