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

implement new macro system

Browse Source
This commit is contained in:
alex-eg
2025-08-05 17:47:04 +03:00
committed by Pavel Kulyov
parent 4245463714
commit 6c6e00e6dc
9 changed files with 116 additions and 221 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
Makefile
View File

@@ -1,6 +1,6 @@
CHICKEN_C = csc
MODULES = sexc modules templates utils fmt-c
MODULES = sexc sex-macros sex-modules utils fmt-c
OBJ = $(MODULES:%=%.o)
sexc: main.o $(OBJ)
@@ -9,9 +9,6 @@ sexc: main.o $(OBJ)
main.o: main.scm
$(CHICKEN_C) $< -c -o $@
templates.o: templates.scm
$(CHICKEN_C) $< -c -o $@ -compile-syntax
%.o: %.scm
$(CHICKEN_C) $< -e -c -o $@

121
Readme.org
View File

@@ -87,124 +87,51 @@ being compiled location, and the second is ~SEX_MODULE_PATH~
environment variable.
Module's public interface consists of everything declared
~pub~. Structures, function, templates, types, variables can be
~pub~. Structures, function, macros, types, variables can be
public.
** Syntactic templates
Sex has support for template substitutions. Any piece of code can be
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 undergo 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.
Formally, template declaration has the following syntax:
#+begin_src
(template (name . substitute-args) . body)
#+end_src
** Syntactic macros
Sex has support for syntactic macros. Macro definitions look like
functions: they have a name, an argument list and a body. Macro should
return Sex code.
*** Examples:
**** Structure with templated value type
#+begin_src
(template (foo ?T)
(struct foo-?T
((?T value))))
(pub defmacro (list-T type)
(let ((list-type (cat 'list- type)))
`(struct ,list-type
((,type value)
((* ,list-type) next)))))
(foo float)
(list-T int)
#+end_src
->
#+begin_src
typedef struct foo_float foo_float;
struct foo_float {
float value;
};
(struct list_int
((int value)
((* list_int) next)))
#+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)
(if (< 0 call)
(pub defmacro (check-sdl-return call message ret-code)
`((if (< 0 ,call)
(begin
(puts message)
(return ret-code))))
(puts ,message)
(return ,ret-code)))))
(fn int init ()
(pub fn int init ()
(check-sdl-return
(SDL-Init SDL-INIT-VIDEO) "Failed to initialize SDL" 1)
...)
#+end_src
->
#+begin_src
static int init () {
if (0 < SDL_Init(SDL_INIT_VIDEO)) {
puts("Failed to initialize SDL");
return 1;
}
return 0;
}
#+end_src
**** A bit of everything
#+begin_src
(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"))
#+end_src
Then will be expanded in the following code:
#+begin_src
(typedef struct list_int list_int)
(struct list_int ((int value) ((* list_int) next)))
(%fun void
print_list
(((const list_int) *l))
(%var int v (-> l value))
(while (!= (-> l next) NULL)
(printf "%d " v)
(= l (-> l next))
(= v (-> l value)))
(printf "\n"))
#+end_src
And then translated to:
#+begin_src
typedef struct list_int list_int;
struct list_int {
int value;
list_int *next;
};
void print_list (const list_int *l) {
int v = l->value;
while (l->next != NULL) {
printf("%d ", v);
l = l->next;
v = l->value;
}
printf("\n");
(%fun int init ()
(if (< 0 (SDL_Init SDL_INIT_VIDEO))
(%begin (puts "Failed to initialize SDL") (return 1)))
...)
}
#+end_src
@@ -218,7 +145,7 @@ To harness the power of sex-mode, add the following lines to your
#+begin_src
(use-package sex-mode
:load-path "/path/to/sex"
:mode ("\\.sex\\'" "\\.seh\\'"))
:mode ("\\.sex\\'"))
#+end_src
** COMING SOON?: Polymorphism

59
example/list.sex
View File

@@ -1,37 +1,46 @@
(pub template (list-T ?T)
(struct list-?T
((?T value)
((* list-?T) next))))
(pub defmacro (list-T type)
(let ((list-type (cat 'list- type)))
`(struct ,list-type
((,type value)
((* ,list-type) next)))))
(pub 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))))
(pub defmacro (make-list-T type is-public?)
(let ((list-type (cat 'list- type))
(fn-name (cat 'make-list- type)))
`(,@(if is-public? '(pub) '()) fn (* ,list-type) ,fn-name ()
(var (* ,list-type) list (cast (* ,list-type) (malloc (sizeof ,list-type))))
(= (-> list next) NULL)
list))
(return list))))
(pub template (add-value-list-T ?T is-public?)
(,@(if 'is-public? '(pub) '()) fn void add-value-list-?T ((list-?T *list) (?T value))
(pub defmacro (add-value-list-T type is-public?)
(let ((list-type (cat 'list- type))
(fn-name (cat 'add-value-list- type)))
`(,@(if is-public? '(pub) '()) fn void ,fn-name ((,list-type *list) (,type value))
(while (!= (-> list next) NULL)
(= list (-> list next)))
(= (-> list next) (make-list-?T))
(= (-> list value) value)))
(= (-> list next) (,(cat 'make-list- type)))
(= (-> list value) value))))
(pub template (length-list-T ?T is-public?)
(,@(if 'is-public? '(pub) '()) fn size-t length-list-?T ((list-?T *list))
(pub defmacro (length-list-T type is-public?)
(let ((fn-name (cat 'length-list- type))
(list-type (cat 'list- type)))
`(,@(if is-public? '(pub) '()) fn size-t ,fn-name ((,list-type *list))
(var size-t n 0)
(while (!= (-> list next) NULL)
(= list (-> list next))
(++ n))
n))
(return n))))
(pub template (is-empty-list-T ?T is-public?)
(,@(if 'is-public? '(pub) '()) fn bool is-empty-list-?T ((list-?T *list))
(== (-> list next) NULL)))
(pub defmacro (is-empty-list-T type is-public?)
`(,@(if is-public? '(pub) '()) fn bool ,(cat 'is-empty-list- type)
((,(cat 'list- type) *list))
(return (== (-> list next) NULL))))
(pub template (list-for-each list-type list-var elt-type elt-var what-do)
(var (pointer list-type) list-var-2 list-var)
(var elt-type elt-var (-> list-var-2 value))
(while (!= (-> list-var-2 next) NULL)
what-do
(= list-var-2 (-> list-var-2 next))
(= elt-var (-> list-var-2 value))))
(pub defmacro (list-for-each list-type list-var elt-type elt-var what-do)
(let ((list-var-2 (cat list-var '-2)))
`((var (pointer ,list-type) ,list-var-2 ,list-var)
(var ,elt-type ,elt-var (-> ,list-var-2 value))
(while (!= (-> ,list-var-2 next) NULL)
,what-do
(= ,list-var-2 (-> ,list-var-2 next))
(= ,elt-var (-> ,list-var-2 value))))))

4
example/test-list.sex
View File

@@ -25,7 +25,7 @@
(is-empty-list-T int #f)
(extern fn void puk ((int a) (float b)))
(fn int bar () ,(imports-test 10 20 30))
(fn int bar () (return ,(imports-test 10 20 30)))
(pub fn void baz () true)
(extern var int i)
@@ -43,7 +43,7 @@
(printf "\n")
(printf "Size of the list: %zu\n" (length-list-int l))
(printf "%p\n" l->next)
0)
(return 0))
(pub fn void print-list (((const list-int) *l))
(list-for-each (const list-int) l int v (printf "%d " v))

30
sex-macros.scm Normal file
View File

@@ -0,0 +1,30 @@
(declare (unit sex-macros))
(import
(chicken plist)
(chicken string))
(define (cat-syms s-1 s-2)
(import fmt)
(fmt #f s-1 s-2))
(define (cat sym-1 sym-2)
(string->symbol (cat-syms sym-1 sym-2)))
(define (register-macro name arglist body)
(put! name 'sex-macro
`(lambda ,arglist
,@body)))
(define (get-macro name)
(eval (get name 'sex-macro)))
(define (macro? form)
(and (list? form)
(symbol? (car form))
(get (car form) 'sex-macro)))
(define (defmacro form)
(let ((arglist (car form))
(body (cdr form)))
(register-macro (car arglist) (cdr arglist) body)))

4
sex-mode.el
View File

@@ -33,13 +33,13 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
"chicken-import"
"chicken-load"
"define"
"defmacro"
"extern"
"import"
"include"
"fn"
"pub"
"struct"
"template"
"var"
"union")
'word)
@@ -78,7 +78,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
(put 'fn 'lisp-indent-function 'defun)
(put 'pub 'lisp-indent-function 'defun)
(put 'template 'lisp-indent-function 'defun)
(put 'defmacro 'lisp-indent-function 'defun)
(put 'struct 'lisp-indent-function 'defun)
(put 'var 'lisp-indent-function 0)
(put 'import 'lisp-indent-function 1)

2
modules.scm → sex-modules.scm
View File

@@ -71,7 +71,7 @@
;; fn type name (arg-list) (body)
;; 1 2 3 4 - we need first 4
(cons (take (cdr form) 4) acc))
((define import include struct template typedef union var)
((define defmacro import include struct typedef union var)
(cons (cdr form) acc))
(else (error "Pub what? " (cadr form)))))
(else acc)))

30
sexc.scm
View File

@@ -1,7 +1,7 @@
(declare (unit sexc)
(uses sex-modules
fmt-c
templates))
(uses fmt-c
sex-macros
sex-modules))
(include "utils.macros.scm")
@@ -54,6 +54,8 @@
(string->symbol
(fmt #f (cadr form) (car form)))))
(require-library chicken-syntax)
(define (walk-generic form acc)
(cond
((null? form) (cons '() acc))
@@ -82,12 +84,12 @@
(char=? #\. (string-ref (symbol->string (car form)) 0)))
(cons (make-field-access form) acc))
;; another special case - template
((template? form)
;; another special case - macro
((macro? form)
(append (fold-right
walk-generic
(list)
(eval form))
(apply (get-macro (car form)) (cdr form)))
acc))
;; toplevel, or a start of a regular list form
@@ -138,22 +140,18 @@
(walk-function form #f acc))
((var)
(append (walk-generic (list 'static (cdr form)) (list)) acc))
((define import include struct template typedef union var)
((define defmacro import include struct typedef union var)
;; ignore here, used in generating public interface
(process-form (cdr form) acc))
(else (error "Pub what?" (cadr form)))))
(define (template? form)
(and (list? form)
(symbol? (car form))
(get (car form) 'sex-template)))
(else
(error "Pub what?" (cadr form)))))
(define (walk-sex-tree form acc)
(if (list? form)
(if (template? form)
(if (macro? form)
(fold-right (fn (walk-sex-tree x y))
acc
(eval form))
(list (apply (get-macro (car form)) (cdr form))))
(case (car form)
((fn) (walk-function form #t acc))
((extern) (walk-extern form acc))
@@ -169,7 +167,7 @@
(define (process-form form acc)
(case (car form)
((chicken-define) (eval (cons 'define (cdr form))) acc)
((template) (eval form) acc)
((defmacro) (defmacro (cdr form)) acc)
((chicken-load)
(load (cadr form)) acc)
((chicken-import)

66
templates.scm
View File

@@ -1,66 +0,0 @@
(declare (unit templates))
(import
brev-separate
(chicken plist)
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))