Add type db, some nice macro features and a brand new SDL3 example #27

Merged
pkulev merged 14 commits from sdl-example into main 2026-09-18 00:11:05 +02:00
7 changed files with 60 additions and 11 deletions
Showing only changes of commit 847bb14340 - Show all commits

View File

@@ -382,10 +382,17 @@ forms, and what remains."
(define (walk-enum form) (define (walk-enum form)
(match form (match form
;; Naming one without defining it: `(var m (enum mood))', the same
;; shape walk-struct accepts for `(struct foo)'. Guarded, and
;; before the anonymous case, since `(enum (red green))' is also a
;; two-element form
(('enum (? symbol? name))
`(enum ,(atom-to-fmt-c name)))
(('enum (values ...)) (('enum (values ...))
`(enum ,(map atom-to-fmt-c values))) `(enum ,(map atom-to-fmt-c values)))
(('enum name (values ...)) (('enum name (values ...))
`(enum ,(atom-to-fmt-c name) ,(map atom-to-fmt-c values))))) `(enum ,(atom-to-fmt-c name) ,(map atom-to-fmt-c values)))
(else (sex-error form "malformed enum" form))))
(define (walk-extern form) (define (walk-extern form)
(match form (match form
@@ -410,6 +417,7 @@ forms, and what remains."
('struct . _) ('struct . _)
('union . _) ('union . _)
('enum . _)
('typedef . _)) ('typedef . _))
;; ignore here, used in generating public interface ;; ignore here, used in generating public interface
@@ -423,7 +431,10 @@ forms, and what remains."
(('fn . _) (list 'static (walk-function form))) (('fn . _) (list 'static (walk-function form)))
(('var . _) (list 'static (walk-var form))) (('var . _) (list 'static (walk-var form)))
(('extern . rest) (walk-extern rest)) (('extern . rest) (walk-extern rest))
(('pub . rest) (walk-public rest)) ;; The cdr of a form has no location of its own, so hand it the
;; `pub' form's -- otherwise a complaint about what follows `pub'
;; cannot say where it was written
(('pub . rest) (walk-public (copy-form-source! form rest)))
((or ('struct . _) ((or ('struct . _)
('union . _)) (walk-struct form)) ('union . _)) (walk-struct form))
(('enum . _) (walk-enum form)) (('enum . _) (walk-enum form))

View File

@@ -640,16 +640,22 @@
(define (c-union . args) (apply c-struct/aux "union" args)) (define (c-union . args) (apply c-struct/aux "union" args))
(define (c-class . args) (apply c-struct/aux "class" args)) (define (c-class . args) (apply c-struct/aux "class" args))
;; MODIFIED FROM UPSTREAM fmt-c: an enum may also be named without
;; being defined -- `enum color m;' -- exactly as c-struct/aux
;; already allows `struct point p;'. Upstream assumed a value list
;; was always present and mapped over whatever stood in its place.
(define (c-enum x . o) (define (c-enum x . o)
(define (c-enum-one x) (define (c-enum-one x)
(if (pair? x) (cat (car x) " = " (c-expr (cadr x))) (dsp x))) (if (pair? x) (cat (car x) " = " (c-expr (cadr x))) (dsp x)))
(let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x)) (let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x))
(vals (if name (car o) x))) (vals (if name (if (null? o) #f (car o)) x)))
(c-wrap-stmt (if vals
(cat (c-wrap-stmt
(c-braced-block (cat
(if name (cat "enum " name) (dsp "enum")) (c-braced-block
(c-in-expr (apply c-begin (map c-enum-one vals)))))))) (if name (cat "enum " name) (dsp "enum"))
(c-in-expr (apply c-begin (map c-enum-one vals))))))
(c-wrap-stmt (cat "enum " name)))))
(define (c-attribute . args) (define (c-attribute . args)
(cat "__attribute__ ((" (fmt-join c-expr args ", ") "))")) (cat "__attribute__ ((" (fmt-join c-expr args ", ") "))"))
@@ -743,7 +749,13 @@
(if (and (pair? (cadr type)) (eq? '%array (caadr type))) (if (and (pair? (cadr type)) (eq? '%array (caadr type)))
(c-paren name) (c-paren name)
name)))) name))))
((enum) (apply c-enum name (cdr type))) ;; MODIFIED FROM UPSTREAM fmt-c: upstream passed the
;; declarator's name to c-enum as the enum's tag, so
;; `(var m (enum color))' emitted `enum m {...}' and lost the
;; variable. Enums are laid out like structs: the type, then
;; the name being declared.
((enum)
(cat (apply c-enum (cdr type)) (if name (cat " " name) "")))
((struct union class) ((struct union class)
(cat (apply c-struct/aux (car type) (cdr type)) (if name (cat " " name) ""))) (cat (apply c-struct/aux (car type) (cdr type)) (if name (cat " " name) "")))
(else (fmt-join/last c-expr (lambda (x) (c-type x name)) type " ")))) (else (fmt-join/last c-expr (lambda (x) (c-type x name)) type " "))))

View File

@@ -83,7 +83,7 @@
;; A variable becomes an `extern' declaration ;; A variable becomes an `extern' declaration
((var) ((var)
(cons (copy-form-source! form (cons 'extern (take (cdr form) 3))) acc)) (cons (copy-form-source! form (cons 'extern (take (cdr form) 3))) acc))
((define defmacro import include struct typedef union) ((define defmacro enum import include struct typedef union)
(cons (copy-form-source! form (cdr form)) acc)) (cons (copy-form-source! form (cdr form)) acc))
(else (sex-error form "pub must be followed by a definition" form)))) (else (sex-error form "pub must be followed by a definition" form))))
(else acc))) (else acc)))

View File

@@ -141,6 +141,28 @@ compiles."
(test-assert "a comment in a body stays in the body" (test-assert "a comment in a body stays in the body"
(emits? (in-fn "(while (< a b) ;; inside\n (g 1))") (emits? (in-fn "(while (< a b) ;; inside\n (g 1))")
"while (a < b) {"))) "while (a < b) {")))
(test-group "pub enum"
(test-assert "is emitted"
(emits? "(pub enum color (red green blue))" "enum color"))
(test-assert "with its values"
(emits? "(pub enum color (red green blue))" "red"))
(test-assert "and a non-pub enum still is too"
(emits? "(enum color (red green blue))" "enum color"))
;; Naming an enum as a type, rather than defining it, had no
;; walk-enum clause and died with `(match) no matching pattern'
(test-assert "and it can then be used as a type"
(emits? "(enum color (red green blue)) (fn f () void (var m (enum color) red))"
"enum color m = red"))
(test-assert "a malformed enum is rejected with its location"
(reports? "(enum)" "codegen.sex:1:"))
;; c-type handed the declarator's name to c-enum as the enum tag,
;; so this emitted `enum m { up, down }' with no variable at all
(test-assert "an anonymous enum keeps the variable"
(emits? "(fn f () void (var e (enum (up down)) up))" "} e = up"))
(test-assert "and a named definition keeps both"
(emits? "(fn f () void (var n (enum named (a b)) a))" "enum named{")))
;; `|', `||' and `|=' read as ordinary symbols -- our own reader has ;; `|', `||' and `|=' read as ordinary symbols -- our own reader has
;; no |symbol| syntax for them to collide with -- but fmt-c cannot ;; no |symbol| syntax for them to collide with -- but fmt-c cannot
;; dispatch on a symbol whose name it cannot write in Scheme source, ;; dispatch on a symbol whose name it cannot write in Scheme source,

View File

@@ -14,7 +14,7 @@
SEXC ?= ../../sexc SEXC ?= ../../sexc
EXPECTED = hello, world\nhello, sex\n2 greetings\ntext times EXPECTED = hello, world\nhello, sex\n2 greetings\ntext times \nmood 1
check: check:
@$(SEXC) greet.sex -c -o greet.o @$(SEXC) greet.sex -c -o greet.o

View File

@@ -21,4 +21,6 @@
(printf "%d greetings\n" greet-count) (printf "%d greetings\n" greet-count)
(describe-fields greeting) (describe-fields greeting)
(printf "\n") (printf "\n")
(var m (enum mood) grumpy)
(printf "mood %d\n" m)
(return 0)) (return 0))

View File

@@ -11,6 +11,8 @@
(pub struct greeting ((text (* const char)) (times int))) (pub struct greeting ((text (* const char)) (times int)))
(pub enum mood (cheerful grumpy))
;;; Compile-time reflection across the module boundary: both the macro ;;; Compile-time reflection across the module boundary: both the macro
;;; and the struct it asks about are exported, and the importing unit ;;; and the struct it asks about are exported, and the importing unit
;;; has to know the struct's fields to expand this. ;;; has to know the struct's fields to expand this.