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 compound-literals
 
 # Multi-module linking is checked end to end; see tests/modules/Makefile.
 check-modules: sexc

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

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)))))

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)
@@ -176,9 +172,7 @@ forms, and what remains."
 
 (define (walk-expr form)
   (match form
-    ((? vector?)
+    ((? vector?) (walk-initializer (vector->list form)))
-     (list->vector
-      (walk-expr (vector->list form))))
     ((? atom?)
      (atom-to-fmt-c form))
     ;; (comment "text") -> /* text */. `%comment' is the fmt-c directive.
@@ -238,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)
@@ -380,8 +416,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 name arglist ret-type body) -> normal function
-  ;; (fn ret-type name arglist) -> prototype
+  ;; (fn name arglist ret-type) -> prototype
   (if (>= (length form) 5)
       (walk-fn-def form)
       (cons '%prototype (cdr (walk-fn-def form)))))

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))))
 

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
+            ((c-wrap-stmt (c-braced-list (vector->list x))) st))
-              (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))
            (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 " "))))

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)

tests/basic.scm

@@ -31,10 +31,10 @@
   (test 'vector-ref (atom-to-fmt-c '¤))
   (test '%include (atom-to-fmt-c 'include))
 
-  ;; c89 stuff
+  ;; C99 onwards, true C spellings for bool
-  (test 'int (atom-to-fmt-c 'bool))
+  (test 'bool (atom-to-fmt-c 'bool))
-  (test 1 (atom-to-fmt-c 'true))
+  (test 'true (atom-to-fmt-c 'true))
-  (test 0 (atom-to-fmt-c 'false))
+  (test 'false (atom-to-fmt-c 'false))
 
   ;; dot-access -> %. member-access directive (kebab-converted operands)
   (test '(%. a b) (walk-expr '(dot-access a 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)))
@@ -150,7 +183,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)

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))

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))