unshittify templates

lib/list.hsex

@@ -1,40 +1,36 @@
-(template (T)
-  struct list-T
-  ((T value)
-   ((list-T *) next)))
+(template (list-T (T))
+  (struct list-T
+    ((T value)
+     ((* list-T) next))))
 
-(template (T)
-  pub fn (list-T *) make-list-T ()
-  (var (list-T *) list (malloc (sizeof list-T)))
-  (= (-> list next) NULL)
-  list)
+(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 (T)
-  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 value) 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 value) value)))
 
-(template (T)
-  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 (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 (T)
-  pub fn bool is-empty-list-T ((list-T *list))
-  (== (-> list next) NULL))
+(template (is-empty-list-T (T) is-public?)
+  (,@(if is-public? '(pub) '()) fn bool is-empty-list-T ((list-T *list))
+    (== (-> list next) NULL)))
 
-(define-syntax list-for-each
-  (syntax-rules ()
-    ((_ list-var elt-var what-do ...)
-     '(begin
-        ;; todo: that int here is not good
-        (var int elt-var (-> list-var value))
-        (while (!= (-> list-var next) NULL)
-         what-do ...
-         (= list-var (-> list-var next))
-         (= elt-var (-> list-var value)))))))
+(template (list-for-each (what-do list-var elt-var))
+  (var int elt-var (-> list-var value))
+  (while (!= (-> list-var next) NULL)
+    what-do
+    (= list-var (-> list-var next))
+    (= elt-var (-> list-var value))))

lib/test-list.sex

@@ -5,11 +5,17 @@
 
 (load "list.hsex")
 
-(instance list-int list-T (int))
-(instance make-list-int make-list-T (int))
-(instance add-value-list-int add-value-list-T (int))
-(instance length-list-int length-list-T (int))
-(instance is-empty-list-int is-empty-list-T (int))
+(struct foo
+  ((float a)
+   (int b)))
+
+,(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)
+
+(fn bool bar () false)
 
 (pub fn int main ()
      (var (* list-int) l (make-list-int))
@@ -17,6 +23,6 @@
      (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 l v (printf "%d " v))
+     ,(list-for-each '((printf "%d " v) l v))
      (printf "\n")
      0)

sexc.scm

@@ -45,37 +45,44 @@
              (eq? (car node) symbol))
         #f)))
 
-(define (walk-generic form)
-  (tree-map
-   atom-to-fmt-c
-   (let ((ret-form form))
-     (let loop ((unquote-form (tree-find (tree-finder 'unquote) form #f)))
-       (if unquote-form
-           (begin
-             (set! ret-form (tree-replace (invert-tree form)
-                                          unquote-form
-                                          (eval (cadr unquote-form))))
-             (loop (tree-find (tree-finder 'unquote)
-                              ret-form
-                              #f)))
-           ret-form)))))
+(define (walk-generic form acc)
+  (if (eq? (car form) 'unquote)
+      ;; special case - replace top-level unquote with it's expansion
+      (append
+       (fold append (list)
+             (map (fn (walk-sex-tree x (list)))
+                  (eval (cadr form))))
+       acc)
+      (let loop ((unquote-form (tree-find (tree-finder 'unquote) form #f)))
+        (if unquote-form
+            (begin
+              (let* ((inv (invert-tree form))
+                     (pos (tree-local-position inv unquote-form)))
+                (for-each (fn
+                           (set! form (tree-insert inv (tree-parent inv unquote-form) pos x))
+                           (set! inv (invert-tree form)))
+                          (reverse (eval (cadr unquote-form))))
+                (set! form (tree-prune inv unquote-form)))
+              (loop (tree-find (tree-finder 'unquote)
+                               form
+                               #f)))
+            (cons (tree-map atom-to-fmt-c form) acc)))))
 
-(define (walk-function form static)
+(define (walk-function form static acc)
   (if static
-      (list 'static (walk-generic form))
-      (walk-generic (cdr form))))
+      (walk-generic (list 'static form) acc)
+      (walk-generic (cdr form) acc)))
 
 (define (walk-struct form acc)
   (let ((name (unkebabify (cadr form))))
-    (cons (walk-generic form)
-          (cons `(typedef struct ,name ,name) acc))))
+    (walk-generic form (cons `(typedef struct ,name ,name) acc))))
 
 (define (walk-sex-tree form acc)
   (case (car form)
-    ((fn) (cons (walk-function form #t) acc))
-    ((pub) (cons (walk-function form #f) acc))
+    ((fn) (walk-function form #t acc))
+    ((pub) (walk-function form #f acc))
     ((struct) (walk-struct form acc))
-    (else (cons (walk-generic form) acc))))
+    (else (walk-generic form acc))))
 
 (define (process-form form acc)
   (case (car form)

templates.scm

@@ -6,74 +6,14 @@
         srfi-1                          ; list routines
         tree)
 
-;;; template structure storage example:
-;;; (name (T U) ((T field-1) (U field-2))))
-;;;
-;;; template function storage example:
-;;; (name (T U) public? T-ret ((T arg-1) (U arg-2)) body)
-
-(define template-functions (list))
-(define template-structures (list))
-
-(define (template-name template)
-  (first template))
-
-(define (template-subst-list template)
-  (second template))
-
-(define (template-struct-fields template)
-  (third template))
-
-(define (template-fn-public? template)
-  (third template))
-
-(define (template-fn-return-type template)
-  (fourth template))
-
-(define (template-fn-arglist template)
-  (fifth template))
-
-(define (template-fn-body template)
-  (sixth template))
-
-(define (find-template name subst-list template-storage)
-  (find (fn (and (eq? name (template-name x))
-                 (= (length subst-list)
-                    (length (template-subst-list x)))))
-        template-storage))
-
-(define (check-template-doesnt-exist name subst-list)
-  (when (find-template
-         name subst-list
-         template-functions)
-    (error "Template function with this name and number of parameters already exists"))
-  (when (find-template
-         name subst-list
-         template-structures)
-    (error "Template structure with this name and number of parameters already exists")))
-
-(define (register-template-fn subst-list public? return-type name arg-list body)
-  (check-template-doesnt-exist name subst-list)
-  (when +debug+
-    (fmt #t (fmt-join dsp (list "Adding template fn" public? return-type name subst-list) " ") nl))
-  (set! template-functions
-    (cons (list name subst-list public? return-type arg-list body) template-functions)))
-
-(define (register-template-struct subst-list name fields)
-  (check-template-doesnt-exist name subst-list)
-  (when +debug+
-    (fmt #t (fmt-join dsp (list "Adding template structure" name subst-list fields) " ") nl))
-  (set! template-structures
-    (cons (list name subst-list fields) template-structures)))
 
 (define-syntax template
-  (syntax-rules (pub fn struct)
-    ((_ (T ...) pub fn ret-type name args body ...)
-     (register-template-fn (list 'T ...) #t 'ret-type 'name 'args (list 'body ...)))
-    ((_ (T ...) fn ret-type name args body ...)
-     (register-template-fn (list 'T ...) #f 'ret-type 'name 'args (list 'body ...)))
-    ((_ (T ...) struct name fields)
-     (register-template-struct (list 'T ...) 'name 'fields))))
+  (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)))))
 
 (define (apply-symbol-substitution sym subst-alist)
   ;; All non-symbol substitutions will be filtered.
@@ -114,41 +54,3 @@
               st))
         x))
    target))
-
-(define (instantiate-template-fn instance-name fun subst-alist)
-  `(,@((fn (if (template-fn-public? fun) '(pub) '())))
-    fn
-    ,(apply-substitution (template-fn-return-type fun) subst-alist)
-    ,instance-name
-    ,(apply-substitution (template-fn-arglist fun) subst-alist)
-    ,@(apply-substitution (template-fn-body fun) subst-alist)))
-
-(define (instantiate-template-struct instance-name struct subst-alist)
-  (list 'struct instance-name
-        (apply-substitution (template-struct-fields struct)
-                            subst-alist)))
-
-(define (instantiate-template instance-name template subst-list)
-  (let ((struct (find-template template subst-list template-structures))
-        (fn (find-template template subst-list template-functions)))
-    (when (and struct fn)
-      (error (fmt #f "Both template structure and function are defined. Shouldn't have happened\n"
-                  "Struct: " struct nl
-                  "Fn: " fn nl)))
-    (unless (or struct fn)
-      (error (fmt #f "Template with name " template " was not found." nl
-                  "Known template fns: " (fmt-join dsp (map template-name template-functions)
-                                                   "\n                    ")
-                  nl
-                  "Known template structs: " (fmt-join dsp (map template-name template-structures)
-                                                       "\n                       "))))
-    (let ((subst-alist
-           (map cons (template-subst-list (or struct fn)) subst-list)))
-      (if struct
-          (instantiate-template-struct instance-name struct subst-alist)
-          (instantiate-template-fn instance-name fn subst-alist)))))
-
-(define-syntax instance
-  (syntax-rules ()
-    ((_ instance-name template subst-list)
-     (instantiate-template 'instance-name 'template 'subst-list))))