From 26e8e6c374a7bf05cb7405a0d0a4692f363406b2 Mon Sep 17 00:00:00 2001 From: alex-eg Date: Sun, 27 Sep 2026 16:11:05 +0300 Subject: [PATCH 1/3] fix lambdas and add a test to prevent rotting Lambdas rotted because there wasn't any test for them, and after return type moved to the end, lambdas stayed assumning it in the front. We fix this and add test program --- Makefile | 2 +- example/lambdas.sex | 10 ++++---- fmt-c-writer.scm | 4 ++-- semen.scm | 4 ++-- tests/sex-programs/lambdas.sex | 44 ++++++++++++++++++++++++++++++++++ 5 files changed, 54 insertions(+), 10 deletions(-) create mode 100644 tests/sex-programs/lambdas.sex diff --git a/Makefile b/Makefile index 8b15de0..c60e88e 100644 --- a/Makefile +++ b/Makefile @@ -94,7 +94,7 @@ sextest: cp ./tools/sextest/sextest . SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize features \ - feature-flags + feature-flags lambdas # Multi-module linking is checked end to end; see tests/modules/Makefile. check-modules: sexc diff --git a/example/lambdas.sex b/example/lambdas.sex index 4ffaec3..48eb54a 100644 --- a/example/lambdas.sex +++ b/example/lambdas.sex @@ -6,14 +6,14 @@ (pub fn main () int (var a int 10) (var b int 20) - (var (fn ((int) (int)) int) sum-fn sum) + (var sum-fn (fn ((int) (int)) int) sum) - (var (fn ((int) (int)) int) sum-lambda + (var sum-lambda (fn ((int) (int)) int) (lambda ((a int) (b int)) int () (return (+ a b)))) - (var (fn ((int)) int) sum-lambda-2 + (var sum-lambda-2 (fn ((int)) int) (lambda ((a int)) int () (return (+ a 20)))) @@ -28,9 +28,9 @@ (return (+ a b 100))) a b)) - (var (fn ((int)) int) l-1 + (var l-1 (fn ((int)) int) (lambda ((a int)) int () - (var (fn ((int)) int) l-2 + (var l-2 (fn ((int)) int) (lambda ((a int)) int () (return (+ 60 a)))) (return (+ 600 (l-2 a))))) diff --git a/fmt-c-writer.scm b/fmt-c-writer.scm index d64b749..63039ff 100644 --- a/fmt-c-writer.scm +++ b/fmt-c-writer.scm @@ -380,8 +380,8 @@ forms, and what remains." (map arg-type (remove comment-form? form))) (define (walk-function form) - ;; (fn ret-type name arglist body) -> normal function - ;; (fn ret-type name arglist) -> prototype + ;; (fn name arglist ret-type body) -> normal function + ;; (fn name arglist ret-type) -> prototype (if (>= (length form) 5) (walk-fn-def form) (cons '%prototype (cdr (walk-fn-def form))))) diff --git a/semen.scm b/semen.scm index c6e0da8..4262fa1 100644 --- a/semen.scm +++ b/semen.scm @@ -255,10 +255,10 @@ (define (make-aux-lambda-struct name form) (match form - (('lambda ret-type arglist captures . body) + (('lambda arglist ret-type captures . body) ;; Captures are ignored for now, but ;; we'll need them for TODO: closures support - (process-fn (copy-form-source! form `(fn ,ret-type ,name ,arglist ,@body)) + (process-fn (copy-form-source! form `(fn ,name ,arglist ,ret-type ,@body)) (list))) (else (sex-error form "malformed lambda" form)))) diff --git a/tests/sex-programs/lambdas.sex b/tests/sex-programs/lambdas.sex new file mode 100644 index 0000000..8de9a5d --- /dev/null +++ b/tests/sex-programs/lambdas.sex @@ -0,0 +1,44 @@ +(input) +(output "Named fn through a pointer: 30" + "Lambda through a pointer: 30" + "Lambda called in place: 130" + "Nested lambdas: 666") +(return 0) + +;;; Lambdas are lifted into toplevel functions by semen, so what this +;;; really checks is that the lifted `fn' comes out in the argument +;;; order the writer expects -- (fn name arglist ret-type . body). + +(include stdio.h) + +(fn sum ((a int) (b int)) int + (return (+ a b))) + +(pub fn main () int + (var a int 10) + (var b int 20) + + (var sum-fn (fn ((int) (int)) int) sum) + (printf "Named fn through a pointer: %d\n" (sum-fn a b)) + + (var sum-lambda (fn ((int) (int)) int) + (lambda ((a int) (b int)) int () + (return (+ a b)))) + (printf "Lambda through a pointer: %d\n" (sum-lambda a b)) + + (printf "Lambda called in place: %d\n" + ((lambda ((a int) (b int)) int () + (return (+ a b 100))) + a b)) + + ;; A lambda inside a lambda: the inner one is lifted out of a + ;; function that is itself being lifted + (var outer (fn ((int)) int) + (lambda ((x int)) int () + (var inner (fn ((int)) int) + (lambda ((y int)) int () + (return (+ 60 y)))) + (return (+ 600 (inner x))))) + (printf "Nested lambdas: %d\n" (outer 6)) + + (return 0)) -- 2.52.0 From a9b00f213527365ba1588717d01f799ff3b2600b Mon Sep 17 00:00:00 2001 From: alex-eg Date: Sun, 27 Sep 2026 18:06:59 +0300 Subject: [PATCH 2/3] use true bool, since we target c99 onwards --- fmt-c-writer.scm | 4 ---- sexc.scm | 1 + tests/basic.scm | 8 ++++---- tests/fmt-c-writer.scm | 2 +- 4 files changed, 6 insertions(+), 9 deletions(-) diff --git a/fmt-c-writer.scm b/fmt-c-writer.scm index 63039ff..aadac0e 100644 --- a/fmt-c-writer.scm +++ b/fmt-c-writer.scm @@ -120,10 +120,6 @@ forms, and what remains." ((|\||) 'bit-or) ((|\|\||) '%or) ((|\|=|) 'bit-or=) - ;; uh things we do for c89 compatibility - ((bool) 'int) - ((true) 1) - ((false) 0) (else (if (symbol? atom) (unkebabify atom) diff --git a/sexc.scm b/sexc.scm index 111e8f2..3bb54ae 100644 --- a/sexc.scm +++ b/sexc.scm @@ -176,6 +176,7 @@ status, which is ours to pass on." (define prelude '((include inttypes.h) + (include stdbool.h) (typedef u8 uint8-t) (typedef i8 int8-t) diff --git a/tests/basic.scm b/tests/basic.scm index 29fc1b3..3456f0b 100644 --- a/tests/basic.scm +++ b/tests/basic.scm @@ -31,10 +31,10 @@ (test 'vector-ref (atom-to-fmt-c '¤)) (test '%include (atom-to-fmt-c 'include)) - ;; c89 stuff - (test 'int (atom-to-fmt-c 'bool)) - (test 1 (atom-to-fmt-c 'true)) - (test 0 (atom-to-fmt-c 'false)) + ;; C99 onwards, true C spellings for bool + (test 'bool (atom-to-fmt-c 'bool)) + (test 'true (atom-to-fmt-c 'true)) + (test 'false (atom-to-fmt-c 'false)) ;; dot-access -> %. member-access directive (kebab-converted operands) (test '(%. a b) (walk-expr '(dot-access a b))) diff --git a/tests/fmt-c-writer.scm b/tests/fmt-c-writer.scm index ba103c1..663fca4 100644 --- a/tests/fmt-c-writer.scm +++ b/tests/fmt-c-writer.scm @@ -150,7 +150,7 @@ (test '(struct mega_kebab ((int a) ((struct ((int year) (int month) (int day))) dob) - ((%fun int ((int) (%array int))) min))) + ((%fun bool ((int) (%array int))) min))) (walk-struct '(struct mega-kebab ((a int) (dob (struct ((year int) -- 2.52.0 From ca88d9b3861b3a61872fddb793f1e1bd2b17d796 Mon Sep 17 00:00:00 2001 From: alex-eg Date: Sun, 27 Sep 2026 19:35:37 +0300 Subject: [PATCH 3/3] implement compound and designated literals support --- Makefile | 2 +- Readme.org | 32 ++++++++++++++++ fmt-c-writer.scm | 46 ++++++++++++++++++++-- sex-fmt-c.scm | 34 ++++++++++------ tests/fmt-c-writer.scm | 33 ++++++++++++++++ tests/sex-programs/compound-literals.sex | 49 ++++++++++++++++++++++++ 6 files changed, 181 insertions(+), 15 deletions(-) create mode 100644 tests/sex-programs/compound-literals.sex diff --git a/Makefile b/Makefile index c60e88e..56e9a9f 100644 --- a/Makefile +++ b/Makefile @@ -94,7 +94,7 @@ sextest: cp ./tools/sextest/sextest . SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize features \ - feature-flags lambdas + feature-flags lambdas compound-literals # Multi-module linking is checked end to end; see tests/modules/Makefile. check-modules: sexc diff --git a/Readme.org b/Readme.org index 11e4efa..622d6ab 100644 --- a/Readme.org +++ b/Readme.org @@ -175,6 +175,38 @@ e.g. for checking output for other platform: sexc example/sdl3-triangle.sex -C --no-platform-features --features=linux,unix,x86-64 #+end_src +** Aggregate initializers and compound literals +~#(...)~ is a brace initializer. On its own it has no type and takes one +from where it is written: + +#+begin_src scheme +(var p (struct point) #(1 2)) +#+end_src + +A ~:~ inside one ends a type and makes the whole thing a compound +literal --- an unnamed object of that type, usable anywhere an +expression is: + +#+begin_src scheme +(var q (struct point) #(struct point : 3 4)) +(var a (* int) #([int 3] : 10 20 30)) +(draw-line ui #(struct point : 0 0) end) +(var p (* struct point) (& #(struct point : 9 9))) ; an lvalue, so `&' works +#+end_src + +The type is written as bare words, the way it is everywhere else in the +language; ~:~ is what ends it. + +A leading ~.~ names a field, so initializers may be designated, given in +any order, and mixed with positional ones: + +#+begin_src scheme +(var r (struct named) #(struct named : .n 7 .first-name "zoe")) +#+end_src + +A compound literal written inside a block lives until the end of that +block and no longer, so returning its address is a dangling pointer. + ** 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 diff --git a/fmt-c-writer.scm b/fmt-c-writer.scm index aadac0e..c881ae0 100644 --- a/fmt-c-writer.scm +++ b/fmt-c-writer.scm @@ -172,9 +172,7 @@ forms, and what remains." (define (walk-expr form) (match form - ((? vector?) - (list->vector - (walk-expr (vector->list form)))) + ((? vector?) (walk-initializer (vector->list form))) ((? atom?) (atom-to-fmt-c form)) ;; (comment "text") -> /* text */. `%comment' is the fmt-c directive. @@ -234,6 +232,48 @@ forms, and what remains." ;; Drop comments so they will not generate additional comma (else (map walk-expr (remove comment-form? form))))) +;;; #(a b c) is a brace initializer. A `:' inside one ends a type and +;;; turns the whole thing into a C99 compound literal: +;;; #(struct point : 1 2) is (struct point){1, 2}, and the type is +;;; written as bare words, the way it is everywhere else in the +;;; language. `:' is the separator because it is the one thing that can +;;; be neither a type word nor an expression -- a named form would be a +;;; C identifier, and so shadowable (see issue #36). +(define (walk-initializer elements) + (let ((parts (list-split (remove comment-form? elements) ':))) + (if (null? (cdr parts)) + (list->vector (walk-designators (car parts))) + (cons* '%compound + (walk-type (maybe-unwrap-type (car parts))) + (walk-designators (cadr parts)))))) + +;;; `.field value' is a designated initializer; anything else is +;;; positional. C lets the two be mixed, and nothing here stops it. A +;;; leading `.' cannot begin a C identifier, so a field name needs no +;;; keyword to introduce it and cannot collide with one. +(define (walk-designators elements) + (let loop ((es elements) (acc (list))) + (match es + (() (reverse acc)) + (((? designator? d)) + (sex-error elements "designated initializer without a value" d)) + (((? designator? d) value . rest) + (loop rest + (cons (list '%designate + (atom-to-fmt-c (designator-field d)) + (walk-expr value)) + acc))) + ((e . rest) (loop rest (cons (walk-expr e) acc)))))) + +(define (designator? x) + (and (symbol? x) + (let ((s (symbol->string x))) + (and (> (string-length s) 1) + (char=? #\. (string-ref s 0)))))) + +(define (designator-field d) + (string->symbol (substring (symbol->string d) 1))) + (define (walk-var form) ;; (var a int) -> (%var int a) ;; (var a (const int) 32) -> (%var (const int) a 32) diff --git a/sex-fmt-c.scm b/sex-fmt-c.scm index 7740383..8d78d58 100644 --- a/sex-fmt-c.scm +++ b/sex-fmt-c.scm @@ -14,6 +14,7 @@ c-in-expr c-in-stmt c-in-test c-paren c-maybe-paren c-type c-literal? c-literal char->c-char c-struct c-union c-class c-enum c-typedef c-cast + c-braced-list c-compound c-designate c-expr c-expr/sexp c-apply c-op c-indent c-current-indent-string c-wrap-stmt c-open-brace c-close-brace c-block c-braced-block c-begin @@ -277,6 +278,8 @@ ((%comment) ((apply c-comment (cdr x)) st)) ((:) ((apply c-label (cdr x)) st)) ((%cast) ((apply c-cast (cdr x)) st)) + ((%compound) ((apply c-compound (cdr x)) st)) + ((%designate) ((apply c-designate (cdr x)) st)) ((+ - & * / % ! ~ ^ && < > <= >= == != << >> = *= /= %= &= ^= >>= <<=) ; |\|| |\|\|| |\|=| ((apply c-op x) st)) @@ -306,17 +309,7 @@ ((apply c-op "-=" (cdr x)) st)) (else ((c-apply x) st)))))) ((vector? x) - ((c-wrap-stmt - (fmt-try-fit - (fmt-let 'no-wrap? #t - (cat "{" (fmt-join c-expr (vector->list x) ", ") "}")) - (lambda (st) - (let* ((col (fmt-col st)) - (sep (string-append "," (make-nl-space col)))) - ((cat "{" (fmt-join c-expr (vector->list x) sep) - "}" nl) - st))))) - st)) + ((c-wrap-stmt (c-braced-list (vector->list x))) st)) (else ((c-literal x) st)))))) @@ -832,6 +825,25 @@ (cat "(" (c-with-op 'paren (c-expr expr)) ")") (c-expr expr)))) + ;; { a, b, c } -- on one line if it fits, one element per line if not. + (define (c-braced-list ls) + (fmt-try-fit + (fmt-let 'no-wrap? #t (cat "{" (fmt-join c-expr ls ", ") "}")) + (lambda (st) + (let* ((col (fmt-col st)) + (sep (string-append "," (make-nl-space col)))) + ((cat "{" (fmt-join c-expr ls sep) "}" nl) st))))) + + ;; (T){ ... } -- a C99 compound literal, not a cast: the result is an + ;; unnamed object and an lvalue, so `&' on it is legal. At block scope + ;; it lives until the end of the enclosing block and no longer. + (define (c-compound type . init) + (cat "(" (c-type type) ")" (c-braced-list init))) + + ;; .field = value, inside a braced list + (define (c-designate field value) + (cat "." (c-expr field) " = " (c-expr value))) + (define (c-typedef type alias . o) (c-wrap-stmt (cat "typedef " (c-type type alias) (fmt-join/prefix c-expr o " ")))) diff --git a/tests/fmt-c-writer.scm b/tests/fmt-c-writer.scm index 663fca4..9cf76c9 100644 --- a/tests/fmt-c-writer.scm +++ b/tests/fmt-c-writer.scm @@ -101,6 +101,39 @@ '(%var (struct suc *) s (hoge piyo)) (walk-var '(var s (* struct suc) (hoge piyo)))) +;;; Initializers and compound literals + (test "a bare initializer is unchanged" + '#(1 2) + (walk-expr '#(1 2))) + + (test "`:' ends the type and makes it a compound literal" + '(%compound (struct point) 3 4) + (walk-expr '#(struct point : 3 4))) + + (test "the type is bare words, as everywhere else" + '(%compound (const char *) 65) + (walk-expr '#(* const char : 65))) + + (test "and may be an array type" + '(%compound (%array int 3) 10 20 30) + (walk-expr '#(¤ int 3 : 10 20 30))) + + (test "a grouped type is unwrapped the way a declaration's is" + '(%compound (%array int 3) 10) + (walk-expr '#((¤ int 3) : 10))) + + (test "`.field value' is a designated initializer, kebab and all" + '(%compound (struct named) (%designate n 7) (%designate first_name "zoe")) + (walk-expr '#(struct named : .n 7 .first-name "zoe"))) + + (test "positional and designated may be mixed" + '(%compound (struct point) 1 (%designate y 5)) + (walk-expr '#(struct point : 1 .y 5))) + + (test "designators work in an untyped initializer too" + '#((%designate y 5)) + (walk-expr '#(.y 5))) + ;;; Fn defs (test '(%fun void puk ((int) (%array float 8))) diff --git a/tests/sex-programs/compound-literals.sex b/tests/sex-programs/compound-literals.sex new file mode 100644 index 0000000..26a84ef --- /dev/null +++ b/tests/sex-programs/compound-literals.sex @@ -0,0 +1,49 @@ +(input) +(output "plain 1 2" + "literal 3 4" + "designated zoe 7" + "through a pointer 9" + "array 10 20 30" + "argument 6" + "mixed 1 5") +(return 0) + +;;; `:' inside #(...) ends a type and makes the rest a C99 compound +;;; literal. Without one, #(...) is the brace initializer it always was. + +(include stdio.h) + +(struct point ((x int) (y int))) +(struct named ((first-name (* const char)) (n int))) + +(fn sum ((p (struct point))) int + (return (+ (. p x) (. p y)))) + +(pub fn main () int + ;; unchanged: a bare initializer has no type of its own + (var p (struct point) #(1 2)) + (printf "plain %d %d\n" (. p x) (. p y)) + + (var q (struct point) #(struct point : 3 4)) + (printf "literal %d %d\n" (. q x) (. q y)) + + ;; designated, out of declaration order, and kebab-cased + (var r (struct named) #(struct named : .n 7 .first-name "zoe")) + (printf "designated %s %d\n" (. r first-name) (. r n)) + + ;; a compound literal is an lvalue, so its address can be taken -- + ;; until the end of the enclosing block, and no longer + (var pp (* struct point) (& #(struct point : 9 9))) + (printf "through a pointer %d\n" (-> pp x)) + + ;; an array literal decays the way an array does + (var a (* int) #([int 3] : 10 20 30)) + (printf "array %d %d %d\n" (¤ a 0) (¤ a 1) (¤ a 2)) + + (printf "argument %d\n" (sum #(struct point : 2 4))) + + ;; positional and designated may be mixed, as in C + (var m (struct point) #(struct point : 1 .y 5)) + (printf "mixed %d %d\n" (. m x) (. m y)) + + (return 0)) -- 2.52.0