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

@@ -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
+templated. Template declarations look like functions: they have a
-be used. To instance template, use ~,~-prefixed form in Sex
+name, an argument list and a body. When declared template is
-code. During instancing, template arguments in the body get
+encountered during reading of Sex code, its body will udergo syntactic
-replaced with provided values by the following rules:
+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 ...)
+(template (name . substitute-args) . body)
-  body ...)
 #+end_src
 
 *** Examples:
 **** Structure with templated value type
 #+begin_src
-(template (foo (T))
+(template (foo ?T)
-  (struct foo-T
+  (struct foo-?T
-    ((T value))))
+    ((?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
+  (check-sdl-return
-    '((SDL-Init SDL-INIT-VIDEO) "Failed to initialize SDL" 1))
+    (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))
+(template (list-T ?T)
-  (struct list-T
+  (struct list-?T
-    ((T value)
+    ((?T value)
-     ((* list-T) next))))
+     ((* 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)
+(pub fn void print-list (((const list-int) *l))
-     ,(list-for-each '((printf "%d " v) int l v))
+     (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.

example/list.seh

@@ -1,34 +1,34 @@
-(template (list-T (T))
+(template (list-T ?T)
-  (struct list-T
+  (struct list-?T
-    ((T value)
+    ((?T value)
-     ((* list-T) next))))
+     ((* list-?T) next))))
 
-(template (make-list-T (T) is-public?)
+(template (make-list-T ?T is-public?)
-  (,@(if is-public? '(pub) '()) fn (* list-T) make-list-T ()
+  (,@(if 'is-public? '(pub) '()) fn (* list-?T) make-list-?T ()
-   (var (* list-T) list (cast (* list-T) (malloc (sizeof 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?)
+(template (add-value-list-?T ?T is-public?)
-  (,@(if is-public? '(pub) '()) fn void add-value-list-T ((list-T *list) (T value))
+  (,@(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?)
+(template (length-list-?T ?T is-public?)
-  (,@(if is-public? '(pub) '()) fn size-t length-list-T ((list-T *list))
+  (,@(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?)
+(template (is-empty-list-?T ?T is-public?)
-  (,@(if is-public? '(pub) '()) fn bool is-empty-list-T ((list-T *list))
+  (,@(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

example/test-list.sex

@@ -18,11 +18,11 @@
 
 (var foo f #((= .a-field 1.2)))
 
-,(list-T '(int))
+(list-T int)
-,(make-list-T '(int) #f)
+(make-list-T int)
-,(add-value-list-T '(int) #f)
+(add-value-list-T int)
-,(length-list-T '(int) #f)
+(length-list-T int)
-,(is-empty-list-T '(int) #f)
+(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"))

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,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)))))
 

templates.scm

@@ -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 ...)
+    ((template (name . args) . body)
-     (define (name subst-list-arg args ...)
+     (begin
-       (let* ((subst-alist (map cons 'subst-list subst-list-arg))
+       (register-template 'name)
-              (replaced-body (apply-substitution `(body ...) subst-alist)))
+       (define-syntax name
-         replaced-body)))))
+         (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))))