5 Commits

Author SHA1 Message Date
7ed1e99ab0 read the feature flags in sextest in the way sexc does
Some checks failed
Sex CI / build-linux (pull_request) Failing after 5m14s
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
2026-09-21 17:10:41 +03:00
1195e5c191 look past comments in a public form's header 2026-09-21 17:05:11 +03:00
05bab57867 say what is wrong with a pointer type, and stop mangling fn ones
The guard against nested pointer chains searched every sublist for a
`*', including the ones that hold a type of their own.

A function type with a pointer parameter, while the same type with an int
parameter passed. (* [char 4]) was let through as well and came out
as `vector-ref char 4 * p'.

A `*' inside an array or a function type belongs to that type, so the
search stops there. What the flat conversion cannot express is now
named: a fn type is a function pointer already, and a pointer to an
array is not supported.

Parameters of a function type are walked without their names. C writes
a parameter name into a declarator and a type has none, so fmt-c prints
whatever it is handed there as a type: `(s (* char))' came out as
`char(*) s'.

fmt-c printed a nameless array declarator's #f into the C, which showed
up in these parameters.
2026-09-21 17:00:24 +03:00
dc98bb3551 separate tags and typedefs
C has two namespaces and the database had one. A typedef of a tag's
name wiped it.

Tags, i.e. struct, enum and union, share one namespace; they move to a
table of their own. A name resolves the way C does: the ordinary
identifier first, the tag when that leads nowhere.

While resolving a typedef, the target was taken apart with cadr
whatever it was, so (typedef points (¤ point 4)) reported point's
fields as its own -- an array of four points claiming to be a point,
and a macro reaching through it with v->x. Only a name and
(struct|union|enum NAME) name a type now.
2026-09-21 15:28:39 +03:00
08bbe17883 make feature guard produce nothing on eof/closing bracket/paren
A dropped datum is replaced by whatever follows it, but what follows
may be the end of the file or the paren closing the list we are
in. Hand the token back to the caller instead: read-list closes its
list with it and the toplevel loop stops.

A `;' comment between a guard and the form it guards was also taken for
the guarded datum, so the form stayed unconditional and the guard did
nothing. Skip comments when reading the guard.

comment-form? was defined three times over; it moves to utils.
2026-09-21 14:49:24 +03:00
9 changed files with 105 additions and 296 deletions

View File

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

View File

@@ -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 \
-u CHICKEN_INSTALL_REPOSITORY -u CHICKEN_REPOSITORY_PATH \
-u CHICKEN_EGG_CACHE -u CHICKEN_INSTALL_PREFIX \
$(CHICKEN_INSTALL) -repository 2>/dev/null)
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)
# Try project-local chicken repository first. In case it doesn't exist (packaging for distros),
# system-wide repository will be used.
unexport CHICKEN_INSTALL_REPOSITORY
unexport CHICKEN_EGG_CACHE
unexport CHICKEN_INSTALL_PREFIX
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: $(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,11 +82,11 @@ 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 .
@@ -119,11 +116,9 @@ installdirs:
uninstall:
rm -f $(DESTDIR)$(bindir)/sexc
$(EGGS_STAMP) deps-update: export CHICKEN_EGG_CACHE := $(EGGS_DIR)/cache
$(EGGS_STAMP) deps-update: export CHICKEN_INSTALL_REPOSITORY := $(EGGS_DIR)
$(EGGS_STAMP) deps-update: export CHICKEN_INSTALL_PREFIX := $(EGGS_DIR)
$(EGGS_STAMP) deps-update: export CHICKEN_REPOSITORY_PATH := $(EGGS_DIR):$(SYSTEM_CHICKEN_REPO)
# 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)
@@ -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)

View File

@@ -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
~.eggs/~ repository. ~dependencies.txt~ is the unpinned request list.
To refresh ~eggs.lock~ after changing it:
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
** 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

160
semen.scm
View File

@@ -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
;; left in place as ordinary statements and preserved into the
;; generated C.
(strip-header-comments fn-form (fn-header-length fn-form)))
;; ([pub|extern] fn name arglist rettype)
(strip-header-comments fn-form
(if (memq (car fn-form) '(pub extern)) 5 4)))
(define (process-fn sex-fn-raw acc)
(let-values (((doc sex-fn)
(extract-fn-docstring (strip-fn-header-comments sex-fn-raw))))
(let* ((expanded (macro-expand sex-fn))
(env (make-hash-table))
(processed
(walk-form
expanded
fn-walker
(begin
(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-aux-code) (list))
env))))
(with-docstring doc processed
(append (hash-table-ref env :lambda-aux-code) acc)))))
(let* ((sex-fn (strip-fn-header-comments sex-fn-raw))
(expanded (macro-expand sex-fn))
(env (make-hash-table))
(processed
(walk-form
expanded
fn-walker
(begin
(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-aux-code) (list))
env))))
(cons processed
(append (hash-table-ref env :lambda-aux-code) acc))))
(define (fn-walker form env)
(if (eq? 'lambda (car 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! form)
(with-docstring doc form acc)))
(register-aggregate! sex-struct)
(cons sex-struct 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 . _)
('pub 'fn . _)
('extern 'fn . _)) form)
((fn . _) form)
((pub fn . _) form)
(else #f)))
(define (sex-fn-public? fn-form)
(eq? (first 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)))
(eq? (car fn-form) 'pub))
(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)))

View File

@@ -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
;; Reduced to a prototype, still `pub', so the importer declares it
;; with external linkage
(('pub 'fn . _)
(cons (copy-form-source! form (public-fn-interface form)) acc))
(('pub 'var . _)
(match-let ((('pub 'var name type . _) (strip-header-comments form 4)))
(cons (copy-form-source! form `(extern var ,name ,type)) acc)))
(('pub (or 'define 'defmacro 'enum 'import 'include 'struct 'typedef 'union) . _)
(cons (copy-form-source! form (cdr form)) acc))
(('pub . _)
(sex-error form "pub must be followed by a definition" form))
(_ acc)))
(case (car form)
((pub)
(case (cadr form)
;; A function is reduced to a prototype and keeps its `pub', so
;; the importing unit declares it with external linkage
((fn)
(cons (copy-form-source!
form
(take (strip-header-comments form 5) 5))
acc))
;; A variable becomes an `extern' declaration
((var)
(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

View File

@@ -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")))
;; 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. */"))))
(emits? (in-fn "(var q (* * const char) 0)") "const char * * q"))))

View File

@@ -13,9 +13,7 @@
;; counted off by one
int 0)
(pub struct greeting
"A greeting to print."
((text (* const char)) (times int)))
(pub struct greeting ((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))

View File

@@ -1,35 +1,30 @@
(import srfi-69
semen
types)
semen)
(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
(return (cast (+ a b) float))))
'(pub fn float sum ((int a) (int b))
(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 '(fn print-str ((s string)) void) (sex-fn-prototype print-str-fn))
(test '((string s)) (sex-fn-arglist 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 '(pub fn sum ((a int) (b int)) float) (sex-fn-prototype sum-fn))
(test '((return (cast (+ a b) float))) (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)))))
(test '((int a) (int b)) (sex-fn-arglist sum-fn))
(test '(pub fn float sum ((int a) (int b))) (sex-fn-prototype sum-fn))
(test '((return (cast float (+ a b)))) (sex-fn-body sum-fn))
(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)))
;;; 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))))
)
(semen-process sex-code-macro))))

View File

@@ -1,6 +1,6 @@
(compilation "-f alpha -f beta,gamma --features=delta --no-platform-features")
(compilation "-f alpha --features beta --features=gamma --no-platform-features")
(input)
(output "alpha" "beta" "gamma" "delta" "elsewhere")
(output "alpha" "beta" "gamma" "elsewhere")
(return 0)
;;; The flags naming the features, in every spelling sexc takes. This
@@ -19,7 +19,6 @@
#+alpha (puts "alpha")
#+beta (puts "beta")
#+gamma (puts "gamma")
#+delta (puts "delta")
#-unix (puts "elsewhere")
#+unix (puts "here")
(return 0))