From bf83baa508a77770059a7da6f1ae78bcd756a4b3 Mon Sep 17 00:00:00 2001 From: alex-eg Date: Wed, 16 Sep 2026 17:44:56 +0300 Subject: [PATCH] read-time feature expressions '#+' and '#-' introduce conditional compilation: the form that follows is kept only when the feature expression is true, and otherwise is read and thrown away. An expression is a feature name, or and / or / not of them. They are read time, not compile time. Default features are the host's software-version, software-type and machine-type as CHICKEN reports them, plus what --features flag adds. --- Makefile | 2 +- Readme.org | 45 +++++++++++++++++++++++++++++++-- reader.module.scm | 5 +++- reader.scm | 45 ++++++++++++++++++++++++++++++++- sexc.scm | 29 +++++++++++++++++++++ tests/reader.scm | 45 +++++++++++++++++++++++++++++++++ tests/sex-programs/features.sex | 23 +++++++++++++++++ 7 files changed, 189 insertions(+), 5 deletions(-) create mode 100644 tests/sex-programs/features.sex diff --git a/Makefile b/Makefile index 22b1152..76857fa 100644 --- a/Makefile +++ b/Makefile @@ -61,7 +61,7 @@ sextest: $(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 diff --git a/Readme.org b/Readme.org index b3db3fb..9e0b73a 100644 --- a/Readme.org +++ b/Readme.org @@ -31,13 +31,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 +109,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 diff --git a/reader.module.scm b/reader.module.scm index 43a312f..0b0d208 100644 --- a/reader.module.scm +++ b/reader.module.scm @@ -1,3 +1,6 @@ (module reader (read-from-file - read-raw-forms) + read-raw-forms + + current-features + platform-features) "reader.scm") diff --git a/reader.scm b/reader.scm index e902114..45b8fd5 100644 --- a/reader.scm +++ b/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) diff --git a/sexc.scm b/sexc.scm index b807bb0..111e8f2 100644 --- a/sexc.scm +++ b/sexc.scm @@ -9,6 +9,7 @@ (chicken process) (chicken process-context) (chicken port) + (chicken string) ; string-split fmt fmt-c-writer getopt-long @@ -31,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) @@ -98,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) @@ -181,6 +202,14 @@ status, which is ours to pass on." (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") diff --git a/tests/reader.scm b/tests/reader.scm index bb709e7..b525b05 100644 --- a/tests/reader.scm +++ b/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)") ) diff --git a/tests/sex-programs/features.sex b/tests/sex-programs/features.sex new file mode 100644 index 0000000..7f5006a --- /dev/null +++ b/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))