diff --git a/Makefile b/Makefile index c6014fd..d5cb4f9 100644 --- a/Makefile +++ b/Makefile @@ -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 $@ diff --git a/Readme.org b/Readme.org index e9cdc21..f37bdd8 100644 --- a/Readme.org +++ b/Readme.org @@ -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) - (begin - (puts message) - (return ret-code)))) +(pub defmacro (check-sdl-return call message ret-code) + `((if (< 0 ,call) + (begin + (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 diff --git a/example/list.sex b/example/list.sex index 62b2e9c..832e401 100644 --- a/example/list.sex +++ b/example/list.sex @@ -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)))) - (= (-> list next) NULL) - list)) +(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) + (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)) - (while (!= (-> list next) NULL) - (= list (-> list next))) - (= (-> list next) (make-list-?T)) - (= (-> list value) 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) (,(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)) - (var size-t n 0) - (while (!= (-> list next) NULL) - (= list (-> list next)) - (++ n)) - n)) +(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)) + (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)))))) diff --git a/example/test-list.sex b/example/test-list.sex index 912e341..4e4eb63 100644 --- a/example/test-list.sex +++ b/example/test-list.sex @@ -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)) diff --git a/sex-macros.scm b/sex-macros.scm new file mode 100644 index 0000000..9e32108 --- /dev/null +++ b/sex-macros.scm @@ -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))) diff --git a/sex-mode.el b/sex-mode.el index c4f9c90..99434c2 100644 --- a/sex-mode.el +++ b/sex-mode.el @@ -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) diff --git a/modules.scm b/sex-modules.scm similarity index 97% rename from modules.scm rename to sex-modules.scm index 348e53c..8da5f70 100644 --- a/modules.scm +++ b/sex-modules.scm @@ -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))) diff --git a/sexc.scm b/sexc.scm index 7f51748..5b4d9bd 100644 --- a/sexc.scm +++ b/sexc.scm @@ -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) diff --git a/templates.scm b/templates.scm deleted file mode 100644 index c967e20..0000000 --- a/templates.scm +++ /dev/null @@ -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))