read the feature flags in sextest in the way sexc does

sextest resolves #+ and #- itself -- it reads the program and prints
what survives to sexc -- so a flag spelling it does not recognise
decides which branch gets compiled

.gitea/workflows/build.yaml

@@ -57,9 +57,7 @@ jobs:
           hash -r
           csc -version
 
-      - name: Install dependencies
+      # Eggs are pinned in eggs.lock and installed by the Makefile into .eggs/.
-        run: make deps
-
       - name: Build sexc
         run: make && ./sexc --help
 

Makefile

@@ -34,27 +34,24 @@ DEPSLOCK = eggs.lock
 EGGS_DIR := $(abspath .eggs)
 
 # Compiler's own repository (types.db, chicken.*), ignoring ambient venv vars.
-SYSTEM_CHICKEN_REPO := $(shell env \
+SYSTEM_CHICKEN_REPO := $(shell env -u CHICKEN_INSTALL_REPOSITORY -u CHICKEN_REPOSITORY_PATH -u CHICKEN_EGG_CACHE -u CHICKEN_INSTALL_PREFIX $(CHICKEN_INSTALL) -repository 2>/dev/null)
-	-u CHICKEN_INSTALL_REPOSITORY -u CHICKEN_REPOSITORY_PATH \
-	-u CHICKEN_EGG_CACHE -u CHICKEN_INSTALL_PREFIX \
-	$(CHICKEN_INSTALL) -repository 2>/dev/null)
 CHICKEN_ABI := $(notdir $(SYSTEM_CHICKEN_REPO))
 EGGS_STAMP := $(EGGS_DIR)/.installed-$(CHICKEN_ABI)
 
-# Try project-local chicken repository first. In case it doesn't exist (packaging for distros),
+export CHICKEN_EGG_CACHE := $(EGGS_DIR)/cache
-# system-wide repository will be used.
+export CHICKEN_INSTALL_REPOSITORY := $(EGGS_DIR)
-unexport CHICKEN_INSTALL_REPOSITORY
+export CHICKEN_INSTALL_PREFIX := $(EGGS_DIR)
-unexport CHICKEN_EGG_CACHE
-unexport CHICKEN_INSTALL_PREFIX
 export CHICKEN_REPOSITORY_PATH := $(EGGS_DIR):$(SYSTEM_CHICKEN_REPO)
 
 all: sexc
 
-sexc: $(OBJ) main.scm
+sexc: $(EGGS_STAMP) $(OBJ) main.scm
 	$(CHICKEN_C) $(CSC_FLAGS) main.scm -o sexc-tmp -link sexc
         # otherwise csc hangs, probably because it tries to compile to sexc.o first
 	mv sexc-tmp sexc
 
+$(OBJ): $(EGGS_STAMP)
+
 #------------------------------------------------------------------
 
 utils.o: utils.module.scm utils.scm
@@ -85,16 +82,16 @@ sexc.o: sexc.module.scm types.o sexc.scm fmt-c-writer.o sex-macros.o sex-modules
 	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sexc.module.scm -o sexc.o -unit sexc -link fmt-c-writer,sex-macros,sex-modules,reader,semen,types,utils
 
 # Unit testing
-sex-tests:
+sex-tests: $(EGGS_STAMP)
 	$(MAKE) -C ./tests sex-tests
 	cp ./tests/sex-tests ./
 
-sextest:
+sextest: $(EGGS_STAMP)
 	$(MAKE) -C ./tools/sextest sextest
 	cp ./tools/sextest/sextest .
 
 SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize features \
-                    feature-flags lambdas compound-literals
+                    feature-flags
 
 # Multi-module linking is checked end to end; see tests/modules/Makefile.
 check-modules: sexc
@@ -119,11 +116,9 @@ installdirs:
 uninstall:
 	rm -f $(DESTDIR)$(bindir)/sexc
 
-$(EGGS_STAMP) deps-update: export CHICKEN_EGG_CACHE := $(EGGS_DIR)/cache
+# eggs.lock is the pin file (chicken-status -list). Install from it;
-$(EGGS_STAMP) deps-update: export CHICKEN_INSTALL_REPOSITORY := $(EGGS_DIR)
+# do not float versions on a normal build. Regenerating the lock:
-$(EGGS_STAMP) deps-update: export CHICKEN_INSTALL_PREFIX := $(EGGS_DIR)
+#   make deps-update
-$(EGGS_STAMP) deps-update: export CHICKEN_REPOSITORY_PATH := $(EGGS_DIR):$(SYSTEM_CHICKEN_REPO)
-
 $(EGGS_STAMP): $(DEPSLOCK)
 	mkdir -p $(CHICKEN_EGG_CACHE)
 	$(CHICKEN_INSTALL) -force -from-list $(DEPSLOCK)
@@ -131,10 +126,10 @@ $(EGGS_STAMP): $(DEPSLOCK)
 
 deps: $(EGGS_STAMP)
 
-deps-update: $(DEPSFILE) deps-clean
+deps-update: $(DEPSFILE)
+	rm -rf $(EGGS_DIR)
 	mkdir -p $(CHICKEN_EGG_CACHE)
 	$(CHICKEN_INSTALL) -force $$(cat $(DEPSFILE))
-	# Local repo only: a system path here would leak distro eggs into the lock.
 	CHICKEN_REPOSITORY_PATH=$(EGGS_DIR) $(CHICKEN_STATUS) -list | sort > $(DEPSLOCK).tmp
 	mv $(DEPSLOCK).tmp $(DEPSLOCK)
 	touch $(EGGS_STAMP)

Readme.org

@@ -12,25 +12,22 @@ Sex is statically typed, compiled general purpose language.
 First, get yourself a Chicken, then, some Chicken deps. You also will
 need a C compiler.
 
-** Development
+Eggs are installed into a project-local ~.eggs/~ repository; they do not
+touch the Chicken system repository.
+
+** Compilation
 #+begin_src sh
-  make deps
   make
 #+end_src
 
-~make deps~ installs pinned eggs from ~eggs.lock~ into a project-local
+That installs pinned eggs from ~eggs.lock~ into ~.eggs/~ if needed, then
-~.eggs/~ repository. ~dependencies.txt~ is the unpinned request list.
+builds ~sexc~. ~dependencies.txt~ is the unpinned request list. To
-To refresh ~eggs.lock~ after changing it:
+refresh ~eggs.lock~ after changing it:
 
 #+begin_src sh
   make deps-update
 #+end_src
 
-** Packaging for system package managers
-- Depend ~sex~ package on Chicken-6 (with ~libchicken.a~) and all eggs from ~dependencies.txt~.
-- Compile and install with ~make~ (usually no other arguments required).
-- Move resulting ~sexc~ binary to the appropriate place.
-
 ** Static compilation
 The default ~CSC_FLAGS~ include ~-static~, so ~sexc~ does not need
 ~.eggs~ at runtime and ~make install~ stays relocatable. Chicken must
@@ -175,38 +172,6 @@ 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 sum-fn (fn ((int) (int)) int) sum)
+  (var (fn ((int) (int)) int) sum-fn sum)
 
-  (var sum-lambda (fn ((int) (int)) int)
+  (var (fn ((int) (int)) int) sum-lambda
 
        (lambda ((a int) (b int)) int ()
          (return (+ a b))))
 
-  (var sum-lambda-2 (fn ((int)) int)
+  (var (fn ((int)) int) sum-lambda-2
 
        (lambda ((a int)) int ()
          (return (+ a 20))))
@@ -28,9 +28,9 @@
                                             (return (+ a b 100)))
                                           a b))
 
-  (var l-1 (fn ((int)) int)
+  (var (fn ((int)) int) l-1
        (lambda ((a int)) int ()
-         (var l-2 (fn ((int)) int)
+         (var (fn ((int)) int) l-2
               (lambda ((a int)) int ()
                 (return (+ 60 a))))
          (return (+ 600 (l-2 a)))))

fmt-c-writer.scm

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

semen.scm

@@ -72,7 +72,7 @@
     ((or ('var . _)
          ('pub 'var . _)
          ('extern 'var . _)) (process-global-var sex-form acc))
-    (('include . includes) (process-includes sex-form includes acc))
+    (('include _) (cons sex-form acc))
     ((or ('define name . _)
          ('pub 'define name . _))
      (add-define name sex-form)
@@ -92,17 +92,6 @@
 
     (else (sex-error sex-form "unknown top level form" sex-form))))
 
-(define (process-includes sex-form includes acc)
-  ;; consume (include ...) form and add to acc
-  ;; (include <inc>) for each include
-  (let process ((includes includes)
-                (acc acc))
-    (if (null? includes)
-        acc
-        (process (cdr includes)
-                 (cons (copy-form-source! sex-form `(include ,(car includes)))
-                       acc)))))
-
 (define (process-imports module-public-forms acc)
   ;; consume (import ...) form and process imports so
   ;; data types end up in types db
@@ -151,91 +140,28 @@
   (cons (copy-form-source! form `(typedef ,target ,new-type)) acc))
 
 ;;; Fn processing
-;;;
-;;; A string as the first body form is a docstring. In the generated
-;;; C code it will be placed as a C commentary just before the function
-;;; definition (actually that works for all blocky things: enum, struct, union as well).
-
-(define (fn-header-length fn-form)
-  (if (memq (first fn-form) '(pub extern)) 5 4))
-
-(define (fn-core form)
-  ;; The (fn name args rettype . body) list, without pub/extern
-  (if (memq (first form) '(pub extern))
-      (cdr form)
-      form))
-
-(define (take-leading-docstring forms)
-  ;; If FORMS starts with a string, possibly after comment forms, return
-  ;; that string and FORMS without it. Otherwise #f and FORMS unchanged
-  (let loop ((fs forms) (prefix (list)))
-    (match fs
-      (() (values #f forms))
-      (((and cmt ('comment . _)) . rest)
-       (loop rest (cons cmt prefix)))
-      (((? string? doc) . rest)
-       (values doc (append (reverse prefix) rest)))
-      (_ (values #f forms)))))
-
-(define (extract-fn-docstring fn-form)
-  (let ((lift
-         (lambda (proto body)
-           (let-values (((doc rest) (take-leading-docstring body)))
-             (if doc
-                 (values doc (copy-form-source! fn-form (append proto rest)))
-                 (values #f fn-form))))))
-    (match fn-form
-      (('pub 'fn name args ret . body)
-       (lift `(pub fn ,name ,args ,ret) body))
-      (('extern 'fn name args ret . body)
-       (lift `(extern fn ,name ,args ,ret) body))
-      (('fn name args ret . body)
-       (lift `(fn ,name ,args ,ret) body))
-      (_ (values #f fn-form)))))
-
-(define (extract-aggregate-docstring form)
-  ;; A string immediately after the name is the docstring; comments
-  ;; between name and fields are not skipped, they already confuse the
-  ;; writer
-  (match form
-    (('pub (and kind (or 'struct 'union 'enum))
-           (? symbol? name) (? string? doc) . rest)
-     (values doc (copy-form-source! form `(pub ,kind ,name ,@rest))))
-    (((and kind (or 'struct 'union 'enum))
-      (? symbol? name) (? string? doc) . rest)
-     (values doc (copy-form-source! form `(,kind ,name ,@rest))))
-    (_ (values #f form))))
-
-(define (with-docstring doc form acc)
-  ;; acc is newest-first; FORM is consed last so the final reverse
-  ;; emits the comment immediately before the declaration
-  (cons form
-        (if doc
-            (cons (list 'comment doc) acc)
-            acc)))
 
 (define (strip-fn-header-comments fn-form)
-  ;; ([pub|extern] fn name arglist rettype). Comments in the body are
+  ;; ([pub|extern] fn name arglist rettype)
-  ;; left in place as ordinary statements and preserved into the
+  (strip-header-comments fn-form
-  ;; generated C.
+                         (if (memq (car fn-form) '(pub extern)) 5 4)))
-  (strip-header-comments fn-form (fn-header-length fn-form)))
 
 (define (process-fn sex-fn-raw acc)
-  (let-values (((doc sex-fn)
+  (let* ((sex-fn (strip-fn-header-comments sex-fn-raw))
-                (extract-fn-docstring (strip-fn-header-comments sex-fn-raw))))
+         (expanded (macro-expand sex-fn))
-    (let* ((expanded (macro-expand sex-fn))
+         (env (make-hash-table))
-           (env (make-hash-table))
+         (processed
-           (processed
+          (walk-form
-            (walk-form
+           expanded
-             expanded
+           fn-walker
-             fn-walker
+           (begin
-             (begin
+             (set! (hash-table-ref env :fn-name) (sex-fn-name expanded))
-               (set! (hash-table-ref env :fn-name) (sex-fn-name expanded))
+             (set! (hash-table-ref env :lambda-counter) 0)
-               (set! (hash-table-ref env :lambda-counter) 0)
+             (set! (hash-table-ref env :lambda-aux-code) (list))
-               (set! (hash-table-ref env :lambda-aux-code) (list))
+             env))))
-               env))))
+
-      (with-docstring doc processed
+    (cons processed
-                      (append (hash-table-ref env :lambda-aux-code) acc)))))
+          (append (hash-table-ref env :lambda-aux-code) acc))))
 
 (define (fn-walker form env)
   (if (eq? 'lambda (car form))
@@ -255,10 +181,10 @@
 
 (define (make-aux-lambda-struct name form)
   (match form
-    (('lambda arglist ret-type captures . body)
+    (('lambda ret-type arglist captures . body)
      ;; Captures are ignored for now, but
      ;; we'll need them for TODO: closures support
-     (process-fn (copy-form-source! form `(fn ,name ,arglist ,ret-type ,@body))
+     (process-fn (copy-form-source! form `(fn ,ret-type ,name ,arglist ,@body))
                  (list)))
     (else (sex-error form "malformed lambda" form))))
 
@@ -266,9 +192,8 @@
 
 ;;; Record the named structs, unions and enums in the type database
 (define (process-struct sex-struct acc)
-  (let-values (((doc form) (extract-aggregate-docstring sex-struct)))
+  (register-aggregate! sex-struct)
-    (register-aggregate! form)
+  (cons sex-struct acc))
-    (with-docstring doc form acc)))
 
 (define (register-aggregate! form)
   (let* ((f (if (eq? (car form) 'pub) (cdr form) form))
@@ -293,36 +218,45 @@
   "The `form` must be toplevel.
 Returns #f if the form is not a function, returns the form otherwise"
   (match form
-    ((or ('fn . _)
+    ((fn . _) form)
-         ('pub 'fn . _)
+    ((pub fn . _) form)
-         ('extern 'fn . _)) form)
     (else #f)))
 
 (define (sex-fn-public? fn-form)
-  (eq? (first fn-form) 'pub))
+  (eq? (car fn-form) 'pub))
-
-(define (sex-fn-name fn-form)
-  (assert (sex-fn? fn-form)
-          (fmt #f "Form " fn-form " is not a function"))
-  (second (fn-core fn-form)))
-
-(define (sex-fn-arglist fn-form)
-  (assert (sex-fn? fn-form)
-          (fmt #f "Form " fn-form " is not a function"))
-  (third (fn-core fn-form)))
 
 (define (sex-fn-return-type fn-form)
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
-  (fourth (fn-core fn-form)))
+  (if (sex-fn-public? fn-form)
+      (third fn-form)
+      (second fn-form)))
+
+(define (sex-fn-name fn-form)
+  (assert (sex-fn? fn-form)
+          (fmt #f "Form " fn-form " is not a function"))
+  (if (sex-fn-public? fn-form)
+      (fourth fn-form)
+      (third fn-form)))
+
+(define (sex-fn-arglist fn-form)
+  (assert (sex-fn? fn-form)
+          (fmt #f "Form " fn-form " is not a function"))
+  (if (sex-fn-public? fn-form)
+      (fifth fn-form)
+      (fourth fn-form)))
 
 (define (sex-fn-prototype fn-form)
   "Returns all except body"
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
-  (take fn-form (fn-header-length fn-form)))
+  (if (sex-fn-public? fn-form)
+      (take fn-form 5)
+      (take fn-form 4)))
 
 (define (sex-fn-body fn-form)
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
-  (drop fn-form (fn-header-length fn-form)))
+  (if (sex-fn-public? fn-form)
+      (drop fn-form 5)
+      (drop fn-form 4)))

sex-fmt-c.scm

@@ -14,7 +14,6 @@
      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
@@ -278,8 +277,6 @@
               ((%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))
@@ -309,7 +306,17 @@
                  ((apply c-op "-=" (cdr x)) st))
                 (else ((c-apply x) st))))))
            ((vector? x)
-            ((c-wrap-stmt (c-braced-list (vector->list x))) st))
+            ((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))
            (else
             ((c-literal x) st))))))
 
@@ -825,25 +832,6 @@
              (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 " "))))

sex-modules.scm

@@ -8,7 +8,6 @@
   (chicken process-context)
   (chicken string)
   fmt
-  matchable
   reader
   srfi-1
   utils)
@@ -72,35 +71,28 @@
      (list)
      raw-forms)))
 
-(define (public-fn-interface raw-form)
-  ;; (pub fn name args ret . body) -> prototype, keeping a docstring so
-  ;; the importer can emit it above the declaration
-  (let ((form (strip-header-comments raw-form 5)))
-    (match form
-      (('pub 'fn name args ret)
-       form)
-      (('pub 'fn name args ret ('comment . _) . rest)
-       (public-fn-interface `(pub fn ,name ,args ,ret ,@rest)))
-      (('pub 'fn name args ret (? string? doc) . _)
-       `(pub fn ,name ,args ,ret ,doc))
-      (('pub 'fn name args ret . _)
-       `(pub fn ,name ,args ,ret)))))
-
 ;;; TODO: use semen facilities to analyze modules
 (define (process-public-interface-form form acc)
-  (match form
+  (case (car form)
-    ;; Reduced to a prototype, still `pub', so the importer declares it
+    ((pub)
-    ;; with external linkage
+     (case (cadr form)
-    (('pub 'fn . _)
+       ;; A function is reduced to a prototype and keeps its `pub', so
-     (cons (copy-form-source! form (public-fn-interface form)) acc))
+       ;; the importing unit declares it with external linkage
-    (('pub 'var . _)
+       ((fn)
-     (match-let ((('pub 'var name type . _) (strip-header-comments form 4)))
+        (cons (copy-form-source!
-       (cons (copy-form-source! form `(extern var ,name ,type)) acc)))
+               form
-    (('pub (or 'define 'defmacro 'enum 'import 'include 'struct 'typedef 'union) . _)
+               (take (strip-header-comments form 5) 5))
-     (cons (copy-form-source! form (cdr form)) acc))
+              acc))
-    (('pub . _)
+       ;; A variable becomes an `extern' declaration
-     (sex-error form "pub must be followed by a definition" form))
+       ((var)
-    (_ acc)))
+        (cons (copy-form-source!
+               form
+               (cons 'extern (take (cdr (strip-header-comments form 4)) 3)))
+              acc))
+       ((define defmacro enum import include struct typedef union)
+        (cons (copy-form-source! form (cdr form)) acc))
+       (else (sex-error form "pub must be followed by a definition" form))))
+    (else acc)))
 
 (define (load-persistent-module-paths)
   (let ((sex-module-path-env-var

sexc.scm

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

tests/codegen.scm

@@ -230,33 +230,4 @@ compiles."
     (test-assert "grouping sublist still accepted"
       (emits? (in-fn "(var s (* (const struct suc)) 0)") "const struct suc * s"))
     (test-assert "flat chain still accepted"
-      (emits? (in-fn "(var q (* * const char) 0)") "const char * * q")))
+      (emits? (in-fn "(var q (* * const char) 0)") "const char * * q"))))
-
-  ;; A string as the first body form (or after the name of a struct,
-  ;; union or enum) is a docstring: it becomes a comment immediately
-  ;; before the declaration, not a statement inside it.
-  (test-group "docstrings"
-    (test-assert "appears before the function"
-      (emits? "(fn greet ((name (* char))) void \"Greet NAME.\" (printf \"hi\" name))"
-              "/* Greet NAME. */"))
-    (test-assert "and not inside the body as a statement"
-      (not (emits? "(fn greet ((name (* char))) void \"Greet NAME.\" (printf \"hi\" name))"
-                   "\"Greet NAME.\"")))
-    (test-assert "multiline keeps its paragraphs"
-      (emits? "(pub fn main () int \"Entry point.\n\nARGC and ARGV.\" (return 0))"
-              "Entry point."))
-    (test-assert "and the second paragraph too"
-      (emits? "(pub fn main () int \"Entry point.\n\nARGC and ARGV.\" (return 0))"
-              "ARGC and ARGV."))
-    (test-assert "a prototype with only a docstring stays a prototype"
-      (emits? "(fn helper ((a int)) int \"Forward.\")"
-              "helper (int a);"))
-    (test-assert "a string after the first statement is left alone"
-      (emits? "(fn f () void (g) \"not a docstring\")"
-              "\"not a docstring\""))
-    (test-assert "a struct docstring sits above the struct"
-      (emits? "(struct point \"A 2D point.\" ((x int) (y int)))"
-              "/* A 2D point. */"))
-    (test-assert "and an enum docstring too"
-      (emits? "(enum color \"RGB.\" (red green blue))"
-              "/* RGB. */"))))

tests/fmt-c-writer.scm

@@ -101,39 +101,6 @@
    '(%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)))
@@ -183,7 +150,7 @@
   (test
    '(struct mega_kebab ((int a)
                         ((struct ((int year) (int month) (int day))) dob)
-                        ((%fun bool ((int) (%array int))) min)))
+                        ((%fun int ((int) (%array int))) min)))
    (walk-struct '(struct mega-kebab
                          ((a int)
                           (dob (struct ((year int)

tests/modules/greet.sex

@@ -13,9 +13,7 @@
                      ;; counted off by one
   int 0)
 
-(pub struct greeting
+(pub struct greeting ((text (* const char)) (times int)))
-  "A greeting to print."
-  ((text (* const char)) (times int)))
 
 (pub enum mood (cheerful grumpy))
 
@@ -31,7 +29,6 @@
 
 (pub fn greet ;; ...and here the prototype would lose its return type
   ((name (* const char))) void
-  "Print a greeting for NAME."
   (++ greet-count)
   (printf "hello, %s\n" name))
 

tests/semen.scm

@@ -1,35 +1,30 @@
 (import srfi-69
-        semen
+        semen)
-        types)
 
 (define print-str-fn
-  '(fn print-str ((s string)) void
+  '(fn void print-str ((string s))
        (printf "%s" s)))
 
 (define sum-fn
-  '(pub fn sum ((a int) (b int)) float
+  '(pub fn float sum ((int a) (int b))
-        (return (cast (+ a b) float))))
+        (return (cast float (+ a b)))))
 
 (test-group "semen"
   (test-assert (sex-fn? print-str-fn))
   (test #f (sex-fn-public? print-str-fn))
   (test 'void (sex-fn-return-type print-str-fn))
   (test 'print-str (sex-fn-name print-str-fn))
-  (test '((s string)) (sex-fn-arglist print-str-fn))
+  (test '((string s)) (sex-fn-arglist print-str-fn))
-  (test '(fn print-str ((s string)) void) (sex-fn-prototype print-str-fn))
+  (test '(fn void print-str ((string s))) (sex-fn-prototype print-str-fn))
   (test '((printf "%s" s)) (sex-fn-body print-str-fn))
 
   (test-assert (sex-fn? sum-fn))
   (test #t (sex-fn-public? sum-fn))
   (test 'float (sex-fn-return-type sum-fn))
   (test 'sum (sex-fn-name sum-fn))
-  (test '((a int) (b int)) (sex-fn-arglist sum-fn))
+  (test '((int a) (int b)) (sex-fn-arglist sum-fn))
-  (test '(pub fn sum ((a int) (b int)) float) (sex-fn-prototype sum-fn))
+  (test '(pub fn float sum ((int a) (int b))) (sex-fn-prototype sum-fn))
-  (test '((return (cast (+ a b) float))) (sex-fn-body sum-fn))
+  (test '((return (cast float (+ a b)))) (sex-fn-body sum-fn))
-
-  (test-assert (sex-fn? '(extern fn foo () void)))
-  (test 'foo (sex-fn-name '(extern fn foo () void)))
-  (test #f (sex-fn? '(struct point ((x int)))))
 
   (let ((sex-code
          '((defmacro (sum-var name a b c)
@@ -54,78 +49,9 @@
          '((defmacro (x10 a)
              `(* 10 ,a))
 
-           (fn foo ((a int) (b int)) void
+           (fn void foo ((int a) (int b))
                (return (+ a (x10 b)))))))
 
-    (test '((fn foo ((a int) (b int)) void
+    (test '((fn void foo ((int a) (int b))
                 (return (+ a (* 10 b)))))
-          (semen-process sex-code-macro)))
+          (semen-process sex-code-macro))))
-
-;;; Docstrings are lifted out as comment forms sitting before the
-;;; declaration. A string later in a body is left alone.
-
-  (test '((comment "Greet NAME.")
-          (fn greet ((name (* char))) void
-              (printf "Hello %s!\n" name)))
-        (semen-process
-         '((fn greet ((name (* char))) void
-               "Greet NAME."
-               (printf "Hello %s!\n" name)))))
-
-  (test '((comment "Public entry.")
-          (pub fn main () int
-               (return 0)))
-        (semen-process
-         '((pub fn main () int
-                "Public entry."
-                (return 0)))))
-
-  ;; A prototype whose only "body" is a docstring stays a prototype
-  (test '((comment "Forward.")
-          (fn helper ((a int)) int))
-        (semen-process
-         '((fn helper ((a int)) int
-               "Forward."))))
-
-  (test '((fn f () void (g) "not a docstring"))
-        (semen-process
-         '((fn f () void (g) "not a docstring"))))
-
-  ;; `;' comments before the string are skipped when looking for it,
-  ;; and stay in the body
-  (test '((comment "Kept.")
-          (fn f () void (comment " note") (g)))
-        (semen-process
-         '((fn f () void (comment " note") "Kept." (g)))))
-
-  (test '((comment "A 2D point.")
-          (struct t-doc-pt ((x int) (y int))))
-        (semen-process
-         '((struct t-doc-pt "A 2D point." ((x int) (y int))))))
-
-  (test '((x int) (y int))
-        (get-fields 't-doc-pt))
-
-  (test '((comment "RGB.")
-          (enum t-doc-color (red green blue)))
-        (semen-process
-         '((enum t-doc-color "RGB." (red green blue)))))
-
-  (test '((comment "Either.")
-          (union t-doc-val ((i int) (f float))))
-        (semen-process
-         '((union t-doc-val "Either." ((i int) (f float))))))
-
-  ;; Includes
-  (test '((include stdio.h))
-        (semen-process
-         '((include stdio.h))))
-  (test '((include stdio.h)
-          (include stdlib.h))
-        (semen-process
-         '((include stdio.h
-                    stdlib.h))))
-  (test '()
-        (semen-process
-         '((include))))
-)

tests/sex-programs/compound-literals.sex

@@ -1,49 +0,0 @@
-(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

@@ -1,44 +0,0 @@
-(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))