ci: drop manual eggs installation

<OpenGL/gl3.h> does not exist there and -framework is not a gcc flag,
so the documented build line failed with no hint why. #+macosx picks
the header now, and both build lines are in the file -- pkg-config
carries the flags on either platform, apart from Apple's GL framework,
which has no pkg-config file to carry.

.gitea/workflows/build.yaml

@@ -57,20 +57,9 @@ jobs:
           hash -r
           csc -version
 
-      - name: Install eggs
-        run: |
-          set -eu
-          mkdir -p .eggs
-          repo="$(chicken-install -repository)"
-          echo "CHICKEN_INSTALL_REPOSITORY=${PWD}/.eggs" >> "$GITHUB_ENV"
-          echo "CHICKEN_REPOSITORY_PATH=${PWD}/.eggs:${repo}" >> "$GITHUB_ENV"
-          export CHICKEN_INSTALL_REPOSITORY="${PWD}/.eggs"
-          export CHICKEN_REPOSITORY_PATH="${PWD}/.eggs:${repo}"
-          # shellcheck disable=SC2046
-          chicken-install $(cat dependencies.txt)
-
+      # Eggs are pinned in eggs.lock and installed by the Makefile into .eggs/.
       - name: Build sexc
-        run: make sexc && ./sexc --help
+        run: make && ./sexc --help
 
       - name: Run tests
-        run: make run-tests
+        run: make check

.gitignore

@@ -1,5 +1,11 @@
+# Project-local Chicken egg repository
+/.eggs
+
+# Compilation artifacts
 *.o
 *.import.scm
 *.link
 sexc
 sex-tests
+sextest
+tools/sextest/sextest

Makefile

@@ -1,4 +1,6 @@
-CHICKEN_C = csc
+CHICKEN_C ?= csc
+CHICKEN_INSTALL ?= chicken-install
+CHICKEN_STATUS ?= chicken-status
 CSC_FLAGS += -K prefix -static
 # What and why:
 # -emit-all-import-libraries: Emit import-libraries for all defined modules.
@@ -12,17 +14,44 @@ CSC_FLAGS += -K prefix -static
 #     error.
 # -c: Stop after compilation to object files. This one is obvious.
 
+# GNU directory variables. Command line overrides, e.g.
+#   make prefix=$(HOME)/.local install
+#   make DESTDIR=/tmp/stage prefix=/usr install
+prefix = /usr/local
+exec_prefix = $(prefix)
+bindir = $(exec_prefix)/bin
+INSTALL = install
+INSTALL_PROGRAM = $(INSTALL)
+
 MODULE_FLAGS = -emit-all-import-libraries -module-registration -c
 
 # Order matters, since module check correctness on compilation
 MODULES = utils types sex-macros reader sex-modules semen sex-fmt-c fmt-c-writer sexc
 OBJ = $(MODULES:%=%.o)
 
-sexc: $(OBJ) main.scm
+DEPSFILE = dependencies.txt
+DEPSLOCK = eggs.lock
+EGGS_DIR := $(abspath .eggs)
+
+# Compiler's own repository (types.db, chicken.*), ignoring ambient venv vars.
+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)
+CHICKEN_ABI := $(notdir $(SYSTEM_CHICKEN_REPO))
+EGGS_STAMP := $(EGGS_DIR)/.installed-$(CHICKEN_ABI)
+
+export CHICKEN_EGG_CACHE := $(EGGS_DIR)/cache
+export CHICKEN_INSTALL_REPOSITORY := $(EGGS_DIR)
+export CHICKEN_INSTALL_PREFIX := $(EGGS_DIR)
+export CHICKEN_REPOSITORY_PATH := $(EGGS_DIR):$(SYSTEM_CHICKEN_REPO)
+
+all: sexc
+
+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
@@ -53,28 +82,69 @@ 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
+SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize features
 
 # Multi-module linking is checked end to end; see tests/modules/Makefile.
 check-modules: sexc
 	@$(MAKE) --no-print-directory -C ./tests/modules check SEXC=../../sexc
 
-run-tests: sexc sex-tests sextest
-	./sex-tests && ./sextest --sexc=./sexc $(SEX_TEST_PROGRAMS:%=./tests/sex-programs/%.sex) && $(MAKE) check-modules
+# The failure paths are checked end to end; see tests/exit-code/Makefile.
+check-exit-code: sexc
+	@$(MAKE) --no-print-directory -C ./tests/exit-code check SEXC=../../sexc
+
+check run-tests: sexc sex-tests sextest
+	./sex-tests && ./sextest --sexc=./sexc $(SEX_TEST_PROGRAMS:%=./tests/sex-programs/%.sex) && $(MAKE) check-modules && $(MAKE) check-exit-code
+
+install: all installdirs
+	$(INSTALL_PROGRAM) sexc $(DESTDIR)$(bindir)/sexc
+
+install-strip:
+	$(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' install
+
+installdirs:
+	$(INSTALL) -d $(DESTDIR)$(bindir)
+
+uninstall:
+	rm -f $(DESTDIR)$(bindir)/sexc
+
+# eggs.lock is the pin file (chicken-status -list). Install from it;
+# do not float versions on a normal build. Regenerating the lock:
+#   make deps-update
+$(EGGS_STAMP): $(DEPSLOCK)
+	mkdir -p $(CHICKEN_EGG_CACHE)
+	$(CHICKEN_INSTALL) -force -from-list $(DEPSLOCK)
+	touch $@
+
+deps: $(EGGS_STAMP)
+
+deps-update: $(DEPSFILE)
+	rm -rf $(EGGS_DIR)
+	mkdir -p $(CHICKEN_EGG_CACHE)
+	$(CHICKEN_INSTALL) -force $$(cat $(DEPSFILE))
+	CHICKEN_REPOSITORY_PATH=$(EGGS_DIR) $(CHICKEN_STATUS) -list | sort > $(DEPSLOCK).tmp
+	mv $(DEPSLOCK).tmp $(DEPSLOCK)
+	touch $(EGGS_STAMP)
 
 clean:
 	rm -f $(OBJ) main.o
 	rm -f *.import.scm
 	rm -f *.link
 	rm -f sexc sex-tests sextest
+	$(MAKE) -C ./tests clean
 	$(MAKE) -C ./tests/modules clean
+	$(MAKE) -C ./tools/sextest clean
 
-.PHONY: clean run-tests sex-tests sextest check-modules
+deps-clean:
+	rm -rf $(EGGS_DIR)
+
+.PHONY: all check run-tests check-modules check-exit-code \
+        install install-strip installdirs uninstall \
+        deps deps-update deps-clean clean sex-tests sextest

Readme.org

@@ -12,16 +12,46 @@ Sex is statically typed, compiled general purpose language.
 First, get yourself a Chicken, then, some Chicken deps. You also will
 need a C compiler.
 
-** Install Chicken Eggs
-Tip: there's a way to make Chicken install eggs non-globally. You need
-to export ~CHICKEN_INSTALL_REPOSITORY~ and ~CHICKEN_REPOSITORY_PATH~
-environment variables. Refer to the documentation for more info:
-https://wiki.call-cc.org/man/5/Extension%20tools#changing-the-repository-location
-
-~chicken-install `cat dependencies.txt`~
+Eggs are installed into a project-local ~.eggs/~ repository; they do not
+touch the Chicken system repository.
 
 ** Compilation
-~make~
+#+begin_src sh
+  make
+#+end_src
+
+That installs pinned eggs from ~eggs.lock~ into ~.eggs/~ if needed, then
+builds ~sexc~. ~dependencies.txt~ is the unpinned request list. To
+refresh ~eggs.lock~ after changing it:
+
+#+begin_src sh
+  make deps-update
+#+end_src
+
+** Static compilation
+The default ~CSC_FLAGS~ include ~-static~, so ~sexc~ does not need
+~.eggs~ at runtime and ~make install~ stays relocatable. Chicken must
+provide ~libchicken.a~ (E.g. for gentoo: ~dev-scheme/chicken~ with
+~static-libs~ use flag).
+
+To link dynamically instead (the binary will look for eggs under this
+tree's ~.eggs~ path):
+
+#+begin_src sh
+  make CSC_FLAGS='-K prefix'
+#+end_src
+
+** Installation
+GNU directory variables: ~prefix~, ~exec_prefix~, ~bindir~, ~DESTDIR~.
+
+#+begin_src sh
+  # default installation (/usr/local/bin/)
+  make install
+  # customize the prefix (installs to ~/.local/bin)
+  make prefix=$(HOME)/.local install
+  # staged install for packaging
+  make DESTDIR=/tmp/stage prefix=/usr install
+#+end_src
 
 * Usage
 ** Summary
@@ -31,13 +61,21 @@ Options:
  --c-compiler=ARG         Select C compiler. Defaults to value of SEX_CC
                           environment variable, or if it is empty, to cc
  -c, --compile-object     Compile object file instead of executable program
- -C, --preprocess         Emit C code
+ -f, --features=ARG       Comma-separated feature names, added to the host's own
+                          for #+ and #- feature expressions. May be given
+                          more than once
+ --no-platform-features   Leave out the host's own features. With --features,
+                          this reads a file the way another platform would
+ -C, --emit-c             Emit C code
  --public-interface       Get module's public interface
  -h, --help               Show this help
  -m, --macro-expand       Emit macro-expanded semantically processed Sex code
-                          (sort of IR). May be useful for debugging
  -o, --output=ARG         Write output to file. Default file name is a.out.
                           If -E or -m options are provided, defaults to stdout
+ --line-directives=ARG    How much #line information to emit: statement (default),
+                          toplevel, or none. `statement' is what makes a debugger
+                          land on the right source line; `none' is for reading -C
+                          output by eye
 #+end_src
 ** Compiling Hello World
 #+begin_src shell
@@ -101,6 +139,39 @@ Module's public interface consists of everything declared
 ~pub~. Structures, function, macros, types, variables can be
 public.
 
+** Read-time feature expressions
+Sex is able to use ~#+~ and ~#-~ for conditional compilation: the form that
+follows is kept only when the feature expression is true, and otherwise
+is read and thrown away.
+
+#+begin_src scheme
+#+macosx (include OpenGL/gl3.h)
+#-macosx (include GL/gl.h)
+
+#+(and unix (not macosx)) (define HAVE-EPOLL 1)
+#+end_src
+
+An expression is a feature name, or ~and~, ~or~ and ~not~ of them.
+
+This is read time, not compile time. What does not apply never reaches macro
+expansion, the type database or the generated C.
+
+The features are the host's ~(software-version)~, ~(software-type)~
+and ~(machine-type)~, e.g. ~macosx unix arm64~ or ~linux unix
+x86-64~. ~--features~ adds to them:
+
+#+begin_src shell
+sexc prog.sex -f debug,with-sdl
+sexc prog.sex --features=debug --features=with-sdl
+#+end_src
+
+A feature is never taken away. The host's features can be disabled,
+e.g. for checking output for other platform:
+
+#+begin_src shell
+sexc example/sdl3-triangle.sex -C --no-platform-features --features=linux,unix,x86-64
+#+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

eggs.lock

@@ -0,0 +1,8 @@
+(brev-separate "1.100")
+(fmt "0.8.14")
+(getopt-long "4.0")
+(matchable "1.2")
+(srfi-1 "0.5.1")
+(srfi-13 "0.3.8")
+(srfi-69 "0.5.3")
+(test "1.3")

example/sdl3-triangle.sex

@@ -8,13 +8,29 @@
 ;;; triangle is and how far it has spun are passed in as uniforms, so
 ;;; the geometry itself is uploaded once and never touched again.
 ;;;
-;;; Build:
+;;; Build, macOS:
 ;;;   ./sexc example/sdl3-triangle.sex -o sdl3-triangle -- `pkg-config --cflags --libs sdl3` -framework OpenGL
+;;;
+;;; Build, Linux:
+;;;   ./sexc example/sdl3-triangle.sex -o sdl3-triangle -- `pkg-config --cflags --libs sdl3 gl`
+;;;
+;;; The GL header is the one platform difference, and #+ / #- picks it.
+;;; Apple keeps the core-profile entry points in <OpenGL/gl3.h> and
+;;; links them through -framework OpenGL, which no pkg-config file
+;;; describes; everywhere else the prototypes come from <GL/glext.h>
+;;; with GL_GLEXT_PROTOTYPES defined, and -lGL -- `pkg-config --libs
+;;; gl' -- resolves them. SDL3/SDL_opengl.h is not the shortcut it
+;;; looks like: on Apple it resolves to the 2.1 header, which has no
+;;; glGenVertexArrays and so cannot bind the VAO this program needs.
 
-(define GL-SILENCE-DEPRECATION 1)       ; OpenGL is deprecated on macOS
+#+macosx (define GL-SILENCE-DEPRECATION 1) ; OpenGL is deprecated on macOS
 
 (include SDL3/SDL.h)
-(include OpenGL/gl3.h)
+
+#+macosx (include OpenGL/gl3.h)
+#-macosx (define GL-GLEXT-PROTOTYPES 1)
+#-macosx (include GL/gl.h)
+#-macosx (include GL/glext.h)
 
 (define WINDOW-WIDTH 800)
 (define WINDOW-HEIGHT 600)

reader.module.scm

@@ -1,3 +1,6 @@
 (module reader (read-from-file
-                read-raw-forms)
+                read-raw-forms
+
+                current-features
+                platform-features)
   "reader.scm")

reader.scm

@@ -7,6 +7,8 @@
 ;;;   - a leading `.' rewritten to the symbol `dot-access'
 ;;;   - `;' comments preserved as (comment "...") forms, so they can be
 ;;;     re-emitted into the generated C (keeping the source mapping)
+;;;   - #+ / #- feature expressions, which decide at read time what the
+;;;     compiler gets to see at all
 ;;; It also records the source location of every form it reads (see
 ;;; utils' form-source), so the C writer can emit #line directives.
 
@@ -15,6 +17,8 @@
   (scheme base)                         ; make-parameter
   (chicken base)
   (chicken pathname)
+  (chicken platform)                    ; software-version, machine-type
+  (only srfi-1 every any)               ; srfi-1 also has an append-reverse
   utils)
 
 ;;; Sentinels for structural tokens
@@ -160,7 +164,8 @@
    ((string->number s) => identity)
    (else (string->symbol s))))
 
-;;; #-dispatch: booleans, characters, vectors, block/datum comments
+;;; #-dispatch: booleans, characters, vectors, block/datum comments,
+;;; feature expressions
 (define (read-hash port)
   (let ((c (get-ch port)))
     (cond
@@ -171,8 +176,46 @@
      ((char=? c #\() (list->vector (read-list port close-paren)))
      ((char=? c #\|) (skip-block-comment port 1) (next-token port))
      ((char=? c #\;) (read-datum port) (next-token port)) ; datum comment
+     ((char=? c #\+) (read-conditional port #t))
+     ((char=? c #\-) (read-conditional port #f))
      (else (error "Unsupported # syntax" c)))))
 
+;;; Feature expressions
+;;;
+;;;   #+linux   (include GL/gl.h)      kept on Linux
+;;;   #-macosx  (foo)                  kept only on other than macOS
+;;;   #+(and unix (not macosx)) (bar)  and / or / not combine them
+;;;
+(define (platform-features)
+  (list (software-version) (software-type) (machine-type)))
+
+;;; The host's features are the default, so anything reading Sex sees
+;;; what the compiler would. sexc rebinds this to add --features
+(define current-features (make-parameter (platform-features)))
+
+(define (feature-true? test)
+  (cond
+   ((symbol? test) (and (memq test (current-features)) #t))
+   ((pair? test)
+    (case (car test)
+      ((and) (every feature-true? (cdr test)))
+      ((or) (any feature-true? (cdr test)))
+      ((not)
+       (if (and (pair? (cdr test)) (null? (cddr test)))
+           (not (feature-true? (cadr test)))
+           (error "Feature expression `not' takes exactly one operand" test)))
+      (else (error "Unknown operator in feature expression" (car test)))))
+   (else (error "Malformed feature expression" test))))
+
+;;; The #-/#+ preceded datum is always read -- there is no other way
+;;; to know where it ends -- and then either returned or dropped
+(define (read-conditional port keep-when)
+  (let ((keep (eq? keep-when (feature-true? (read-datum port)))))
+    (if keep
+        (read-datum port)
+        (begin (read-datum port)
+               (next-token port)))))
+
 ;;; #t / #true / #f / #false. `val' is the boolean; consume any
 ;;; trailing name characters and validate
 (define (read-bool port val)

sexc.scm

@@ -2,12 +2,14 @@
         (scheme base)                   ; call/cc
         brev-separate
         (chicken base)
+        (chicken condition)             ; handle-exceptions
         (chicken file)
         (chicken plist)
         (chicken pretty-print)
         (chicken process)
         (chicken process-context)
         (chicken port)
+        (chicken string)                ; string-split
         fmt
         fmt-c-writer
         getopt-long
@@ -30,6 +32,17 @@
                       (required #f)
                       (value #f)
                       (single-char #\c))
+      (features ,(fmt #f "Comma-separated feature names, added to the host's own" nl
+                      (pad padding) "for #+ and #- feature expressions. May be given" nl
+                      (pad padding) "more than once")
+                (required #f)
+                (value #t)
+                (single-char #\f))
+      (no-platform-features
+       ,(fmt #f "Leave out the host's own features. With --features," nl
+             (pad padding) "this reads a file the way another platform would")
+       (required #f)
+       (value #f))
       (emit-c "Emit C code"
               (required #f)
               (value #f)
@@ -97,6 +110,15 @@
           ((equal? v "none") 'none)
           (else (error "--line-directives must be statement, toplevel or none, got" v)))))
 
+
+
+;;; --features may be given more than once, and each may name several.
+;;; Collect all of them
+(define (cli-features args)
+  (append-map (lambda (entry)
+                (map string->symbol (string-split (cdr entry) ",")))
+              (filter (lambda (entry) (eq? (car entry) 'features)) args)))
+
 (define (get-input-file args)
   (let ((rest-args (get-rest-args args)))
     (if (null? rest-args)
@@ -117,15 +139,22 @@
                                  (emit-c sex-forms)))))
 
 (define (compile-to-file sex-forms output args cc-args)
+  "Hand the generated C to the C compiler. Returns the compiler's exit
+status, which is ours to pass on."
   (let ((compiler (or (get-arg args 'c-compiler #f)
                       (get-env-var "SEX_CC")
                       "cc"))
         (out-file (if (eq? output 'default)
                       "a.out"
-                      output)))
+                      output))
         ;; The generated C goes to a temporary .c file rather than the
-    ;; compiler's stdin
-    (let ((c-file (create-temporary-file "c")))
+        ;; compiler's stdin. It is removed however we leave -- emit-c
+        ;; can throw, and used to leave the file behind when it did
+        (c-file (create-temporary-file "c")))
+    ;; An unhandled error ends the process without unwinding, so the
+    ;; cleanup cannot be left to dynamic-wind
+    (handle-exceptions exn
+        (begin (delete-file* c-file) (abort exn))
       (with-output-to-file c-file
         (lambda () (emit-c sex-forms)))
       (let ((proc (process compiler (append (list "-o" out-file)
@@ -135,9 +164,9 @@
                                             (list c-file)
                                             cc-args))))
         (call-with-values (lambda () (process-wait proc))
-          (lambda status
+          (lambda (pid normal-exit? status)
             (delete-file* c-file)
-            (apply values status)))))))
+            (if normal-exit? status 1)))))))
 
 (define (semantic-process-forms raw-forms input-source)
   (if (eq? input-source 'stdin)
@@ -173,6 +202,14 @@
        (when help
          (print-help)
          (return #f))
+       ;; Read time comes before everything, so the features have to be
+       ;; in place before the first form is read
+       (current-features
+        (append (if (get-arg args 'no-platform-features #f)
+                    (list)
+                    (platform-features))
+                (cli-features args)))
+
        (when (get-arg args 'public-interface #f)
          (assert (not (eq? input 'stdin)) "Error: --public-interface requires file argument")
 
@@ -198,5 +235,7 @@
                  (get-arg args 'emit-c #f))
              ;; Emit processed and macro-expanded sex code, or emit C code
              (emit-c-or-sex sex-forms output args)
-             ;; Compile file!
-             (compile-to-file sex-forms output args cc-args)))))))
+             ;; Compile file! The C compiler's status is ours too
+             (let ((status (compile-to-file sex-forms output args cc-args)))
+               (unless (zero? status)
+                 (exit status)))))))))

tests/Makefile

@@ -46,3 +46,5 @@ clean:
 	rm -f *.import.scm
 	rm -f *.link
 	rm -f sex-tests
+
+.PHONY: clean

tests/exit-code/Makefile

@@ -0,0 +1,26 @@
+# The failure paths.
+#
+# Both need a process to show themselves, so neither fits the unit
+# suite: sexc has to fail when cc fails -- exiting 0 after a failed
+# compile makes every driver, sextest included, read it as success --
+# and it has to clean up its temporary .c when its own emission throws.
+#
+# Everything is built inside a scratch TMPDIR, so nothing is left here
+# to clean up.
+
+SEXC ?= ../../sexc
+
+check:
+	@d=`mktemp -d`; \
+	TMPDIR=$$d $(SEXC) nested-pointer.sex -o $$d/out >/dev/null 2>&1; \
+	if [ -n "`find $$d -name '*.c'`" ]; then \
+		echo "exit code FAILED: the temporary .c survived a failed emission"; \
+		rm -rf $$d; exit 1; \
+	fi; \
+	if $(SEXC) hello.sex -o $$d/out -- -no-such-cc-flag >/dev/null 2>&1; then \
+		echo "exit code FAILED: sexc reported success after cc failed"; \
+		rm -rf $$d; exit 1; \
+	fi; \
+	rm -rf $$d; echo "exit code ok"
+
+.PHONY: check

tests/exit-code/hello.sex

@@ -0,0 +1,4 @@
+;;; Compiles cleanly, so the only way the build can fail is the bogus
+;;; flag handed to cc -- which is the point.
+(pub fn main () int
+  (return 0))

tests/exit-code/nested-pointer.sex

@@ -0,0 +1,4 @@
+;;; Rejected by the writer, so emit-c throws: there is a temporary .c
+;;; by then, and it must not survive.
+(fn f () void
+  (var p (* (* char))))

tests/reader.scm

@@ -1,6 +1,14 @@
 (import (chicken port)
         reader)
 
+(define-syntax feature-test
+  (syntax-rules ()
+    ((feature-test result features string)
+     (test result
+           (parameterize ((current-features 'features))
+             (with-input-from-string string
+               (lambda () (read-raw-forms 'stdin))))))))
+
 (define-syntax reader-test
   (syntax-rules ()
     ((reader-test result string)
@@ -38,4 +46,41 @@
   (reader-test '((a b) (comment " t")) "(a b) ; t")
   ;; a `;' inside a string is not a comment
   (reader-test '("a;b") "\"a;b\"")
+
+  ;; #+ / #- feature expressions. What does not apply is read and
+  ;; dropped, so it never reaches the compiler at all
+  (feature-test '((a)) (linux) "#+linux (a)")
+  (feature-test '()    (macosx) "#+linux (a)")
+  (feature-test '()    (linux) "#-linux (a)")
+  (feature-test '((a)) (macosx) "#-linux (a)")
+  ;; the guarded datum can be anything, not only a list
+  (feature-test '(42) (x) "#+x 42")
+  (feature-test '("s") (x) "#+x \"s\"")
+
+  ;; and / or / not
+  (feature-test '((a)) (unix linux) "#+(and unix linux) (a)")
+  (feature-test '()    (unix) "#+(and unix linux) (a)")
+  (feature-test '((a)) (unix) "#+(or linux unix) (a)")
+  (feature-test '()    (bsd)  "#+(or linux unix) (a)")
+  (feature-test '((a)) (unix) "#+(and unix (not macosx)) (a)")
+  (feature-test '()    (unix macosx) "#+(and unix (not macosx)) (a)")
+  ;; (and) is true and (or) is false, as they are in CL
+  (feature-test '((a)) () "#+(and) (a)")
+  (feature-test '()    () "#+(or) (a)")
+
+  ;; a guard inside a form, including as the last element -- dropping
+  ;; continues with the next token, so the closing paren still arrives
+  (feature-test '((f 1 3)) (a) "(f #+a 1 #-a 2 3)")
+  (feature-test '((f 2 3)) (b) "(f #+a 1 #-a 2 3)")
+  (feature-test '((f 1))   (a) "(f #+a 1 #+b 2)")
+  (feature-test '((f))     (b) "(f #+a 1)")
+  ;; ...and as the last form in the file
+  (feature-test '((a)) (x) "(a) #+y (b)")
+
+  ;; guards nest
+  (feature-test '((a)) (x y) "#+x #+y (a)")
+  (feature-test '((b)) (x) "#+x #+y (a) (b)")
+
+  ;; a feature the program was not given is simply absent
+  (feature-test '() () "#+anything (a)")
 )

tests/sex-programs/features.sex

@@ -0,0 +1,23 @@
+(compilation "--features=test-on")
+(input)
+(output "selected" "on" "and-not")
+(return 0)
+
+;;; #+ and #- pick what the compiler gets to see. `test-on' is handed
+;;; to sexc by the (compilation ...) form above, so this program reads
+;;; the same way on every platform.
+
+(include stdio.h)
+
+#+test-on (define GREETING "on")
+#-test-on (define GREETING "off")
+
+#-test-on (pub fn main () int (puts "the whole function is dropped") (return 1))
+
+(pub fn main () int
+  ;; ...and inside a form, not only at toplevel
+  (puts #+test-on "selected" #-test-on "rejected")
+  (puts GREETING)
+  #+(and test-on (not test-off)) (puts "and-not")
+  #-test-on (puts "never printed")
+  (return 0))

tests/types.module.scm

@@ -1,3 +1,14 @@
 (module types
-    *
+    (add-struct
+     add-union
+     add-enum
+     add-typedef
+     add-define
+
+     type-match
+     map-fields
+
+     get-type-info
+     get-fields
+     get-underlying-type)
   "../types.scm")

tools/sextest/reader.module.scm

@@ -1,3 +1,6 @@
 (module reader (read-from-file
-                read-raw-forms)
+                read-raw-forms
+
+                current-features
+                platform-features)
   "../../reader.scm")

tools/sextest/sextest.scm

@@ -7,18 +7,19 @@
         (chicken port)
         (chicken process)
         (chicken process-context)
+        (chicken string)                ; string-split
         fmt
         getopt-long
         reader                          ; read-raw-forms, shared with sexc
-        srfi-1)
+        srfi-1
+        srfi-13)                        ; string-prefix?
 
 (define (print-help)
   (fmt #t "Usage: sextest [options] filename" nl
        "Options:" nl
        (usage opts-grammar) nl))
 
-(define (process-file target-path)
-  (let ((contents (read-raw-forms target-path)))
+(define (split-settings contents)
   (foldl (lambda (acc elt)
            (case (car elt)
              ((compilation input output return)
@@ -30,13 +31,39 @@
                (car acc)
                (append (cdr acc) (list elt))))))
          (cons (list) (list))
-           contents)))
+         contents))
 
-(define (compile src flags sexc)
+;;; --features from the (compilation ...) form, which we have to honour
+;;; ourselves: the program is read here and printed back out for sexc,
+;;; so #+ and #- are resolved on this side
+(define (compilation-features settings)
+  (let ((compilation (assoc 'compilation settings)))
+    (if compilation
+        (append-map (lambda (flag)
+                      (if (string-prefix? "--features=" flag)
+                          (map string->symbol
+                               (string-split (substring flag 11) ","))
+                          (list)))
+                    (string-split (cadr compilation)))
+        (list))))
+
+(define (process-file target-path)
+  (let* ((first-pass (split-settings (read-raw-forms target-path)))
+         (features (compilation-features (car first-pass))))
+    (if (null? features)
+        first-pass
+        (parameterize ((current-features (append (platform-features) features)))
+          (split-settings (read-raw-forms target-path))))))
+
+(define (compile src compilation sexc)
   (let ((compiler (or
                    (and sexc (cdr sexc))
                    (get-environment-variable "SEXC")
                    "sexc"))
+        ;; (compilation "--features=x -- -O2") -- one string
+        (flags (if compilation
+                   (string-split (cadr compilation))
+                   (list)))
         (compiled-file (create-temporary-file)))
     ;; `process' returns one record; `process-input-port' is named from
     ;; the child's side, so it is the port we write to.
@@ -110,7 +137,7 @@
   (let* ((settings-and-src (process-file path))
          (settings (car settings-and-src))
          (src (cdr settings-and-src))
-         (compiled-file (compile src (assoc 'compile settings) sexc)))
+         (compiled-file (compile src (assoc 'compilation settings) sexc)))
     (if (not compiled-file)
         (begin (fmt #t "Failed to compile " path nl)
                #f)