generate temp .c files instead of passing to compiler's stdin

For a clearer architecture

.gitea/workflows/build.yaml

@@ -1,76 +0,0 @@
-name: Sex CI
-
-on:
-  push:
-    branches: [main]
-  pull_request:
-    branches: [main]
-  workflow_dispatch:
-
-jobs:
-  build-linux:
-    runs-on: ubuntu-latest
-    steps:
-      - name: Fetch repository
-        env:
-          GITEA_TOKEN: ${{ secrets.GITEA_TOKEN }}
-        run: |
-          set -eu
-          git config --global --add safe.directory "$PWD"
-          git init
-          git remote add origin "${GITHUB_SERVER_URL%/}/${GITHUB_REPOSITORY}.git"
-          git -c http.extraHeader="Authorization: token ${GITEA_TOKEN}" \
-            fetch --depth 1 origin "${GITHUB_SHA}"
-          git checkout --force FETCH_HEAD
-
-      - name: Install toolchain
-        run: |
-          set -eu
-          if [ "$(id -u)" -eq 0 ]; then
-            apt-get update
-            apt-get install -y --no-install-recommends build-essential git wget ca-certificates
-          else
-            sudo apt-get update
-            sudo apt-get install -y --no-install-recommends build-essential git wget ca-certificates
-          fi
-
-      - name: Install Chicken
-        env:
-          CHICKEN_VERSION: "6.0.0"
-          CHICKEN_SHA256: 92835552b1b687ad26737e429b5aba36510bf429f8816ec0f6d336c8cb41f443
-        run: |
-          set -eu
-          tarball="chicken-${CHICKEN_VERSION}.tar.gz"
-          wget -N "https://code.call-cc.org/releases/${CHICKEN_VERSION}/${tarball}"
-          echo "${CHICKEN_SHA256}  ${tarball}" | sha256sum -c
-          tar zxf "${tarball}"
-          (
-            cd "chicken-${CHICKEN_VERSION}"
-            ./configure --prefix=/usr/local
-            make -j"$(nproc)"
-            if [ "$(id -u)" -eq 0 ]; then
-              make install
-            else
-              sudo make install
-            fi
-          )
-          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)
-
-      - name: Build sexc
-        run: make sexc && ./sexc --help
-
-      - name: Run tests
-        run: make run-tests

.github/workflows/build.yaml

@@ -0,0 +1,55 @@
+name: Sex CI
+
+on:
+  push:
+    branches: [ main ]
+  pull_request:
+    branches: [ main ]
+
+jobs:
+  build-linux:
+
+    runs-on: ubuntu-latest
+
+    steps:
+    - uses: actions/checkout@v3
+    - name: Install chicken
+      run: |
+        wget -N https://code.call-cc.org/releases/6.0.0/chicken-6.0.0.tar.gz
+        tar zxf chicken-6.0.0.tar.gz
+        sudo apt install -y make
+        make -C chicken-6.0.0 PLATFORM=linux
+        sudo make -C chicken-6.0.0 PLATFORM=linux install
+    - name: Install dependencies
+      # FIXME: [project-local deps]: use venv or something
+      # run: make deps
+      run: sudo chicken-install $(cat dependencies.txt)
+    - name: Make sure that sexc builds
+      # FIXME: sexc being built with local .eggs/ libs needs the path at runtime.
+      # Without it there will be `Error: cannot load extension: fmt`.
+      run: make sexc && ./sexc --help
+    - name: Run tests
+      # FIXME: [project-local deps]: use local deps or build with -static
+      # run: make run-tests
+      run: make sex-tests && ./sex-tests
+
+  build-macos:
+
+    runs-on: macos-15
+
+    steps:
+    - uses: actions/checkout@v3
+    - name: Install chicken
+      run: brew install chicken make
+    - name: Install dependencies
+      # FIXME: [project-local deps]: use venv or something
+      # run: make deps
+      run: chicken-install $(cat dependencies.txt)
+    - name: Make sure that sexc builds
+      # FIXME: sexc being built with local .eggs/ libs needs the path at runtime.
+      # Without it there will be `Error: cannot load extension: fmt`.
+      run: make sexc && ./sexc --help
+    - name: Run tests
+      # FIXME: [project-local deps]: use local deps or build with -static
+      # run: make run-tests
+      run: make sex-tests && ./sex-tests

fmt-c-writer.scm

@@ -382,17 +382,10 @@ forms, and what remains."
 
 (define (walk-enum form)
   (match form
-    ;; Naming one without defining it: `(var m (enum mood))', the same
-    ;; shape walk-struct accepts for `(struct foo)'. Guarded, and
-    ;; before the anonymous case, since `(enum (red green))' is also a
-    ;; two-element form
-    (('enum (? symbol? name))
-     `(enum ,(atom-to-fmt-c name)))
     (('enum (values ...))
      `(enum ,(map atom-to-fmt-c values)))
     (('enum name (values ...))
-     `(enum ,(atom-to-fmt-c name) ,(map atom-to-fmt-c values)))
+     `(enum ,(atom-to-fmt-c name) ,(map atom-to-fmt-c values)))))
-    (else (sex-error form "malformed enum" form))))
 
 (define (walk-extern form)
   (match form
@@ -417,7 +410,6 @@ forms, and what remains."
 
          ('struct . _)
          ('union . _)
-         ('enum . _)
 
          ('typedef . _))
      ;; ignore here, used in generating public interface
@@ -431,10 +423,7 @@ forms, and what remains."
     (('fn . _) (list 'static (walk-function form)))
     (('var . _) (list 'static (walk-var form)))
     (('extern . rest) (walk-extern rest))
-    ;; The cdr of a form has no location of its own, so hand it the
+    (('pub . rest) (walk-public rest))
-    ;; `pub' form's -- otherwise a complaint about what follows `pub'
-    ;; cannot say where it was written
-    (('pub . rest) (walk-public (copy-form-source! form rest)))
     ((or ('struct . _)
          ('union . _)) (walk-struct form))
     (('enum . _) (walk-enum form))

semen.scm

@@ -93,9 +93,17 @@
     (else (sex-error sex-form "unknown top level form" sex-form))))
 
 (define (process-imports module-public-forms acc)
-  ;; consume (import ...) form and process imports so
+  ;; Recursively process imports: register public macros, cons all
-  ;; data types end up in types db
+  ;; other public things to our acc
-  (fold match-sex-form acc module-public-forms))
+  (if (null? module-public-forms) acc
+      (match (car module-public-forms)
+        (('defmacro . rest)
+         (defmacro rest)
+         (process-imports (cdr module-public-forms) acc))
+        (else
+         (process-imports (cdr module-public-forms)
+                          (cons (car module-public-forms)
+                                acc))))))
 
 (define (macro-expand form)
   "Walk the form recursively and expand all macros, until none is left."

sex-fmt-c.scm

@@ -640,22 +640,16 @@
   (define (c-union . args) (apply c-struct/aux "union" args))
   (define (c-class . args) (apply c-struct/aux "class" args))
 
-  ;; MODIFIED FROM UPSTREAM fmt-c: an enum may also be named without
-  ;; being defined -- `enum color m;' -- exactly as c-struct/aux
-  ;; already allows `struct point p;'. Upstream assumed a value list
-  ;; was always present and mapped over whatever stood in its place.
   (define (c-enum x . o)
     (define (c-enum-one x)
       (if (pair? x) (cat (car x) " = " (c-expr (cadr x))) (dsp x)))
     (let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x))
-           (vals (if name (if (null? o) #f (car o)) x)))
+           (vals (if name (car o) x)))
-      (if vals
+      (c-wrap-stmt
-          (c-wrap-stmt
+       (cat
-           (cat
+        (c-braced-block
-            (c-braced-block
+         (if name (cat "enum " name) (dsp "enum"))
-             (if name (cat "enum " name) (dsp "enum"))
+         (c-in-expr (apply c-begin (map c-enum-one vals))))))))
-             (c-in-expr (apply c-begin (map c-enum-one vals))))))
-          (c-wrap-stmt (cat "enum " name)))))
 
   (define (c-attribute . args)
     (cat "__attribute__ ((" (fmt-join c-expr args ", ") "))"))
@@ -749,13 +743,7 @@
                      (if (and (pair? (cadr type)) (eq? '%array (caadr type)))
                          (c-paren name)
                          name))))
-          ;; MODIFIED FROM UPSTREAM fmt-c: upstream passed the
+          ((enum) (apply c-enum name (cdr type)))
-          ;; declarator's name to c-enum as the enum's tag, so
-          ;; `(var m (enum color))' emitted `enum m {...}' and lost the
-          ;; variable. Enums are laid out like structs: the type, then
-          ;; the name being declared.
-          ((enum)
-           (cat (apply c-enum (cdr type)) (if name (cat " " name) "")))
           ((struct union class)
            (cat (apply c-struct/aux (car type) (cdr type)) (if name (cat " " name) "")))
           (else (fmt-join/last c-expr (lambda (x) (c-type x name)) type " "))))

sex-modules.scm

@@ -14,10 +14,6 @@
 
 (define +persistent-module-paths+ (list))
 
-;;; for guarding against multiple imports (sort of mandatory #pragma
-;;; once)
-(define +imported-modules+ (list))
-
 (define (get-modules-public-forms module-list)
   ;; Module list is a list of symbols
   ;; How Sex handles modules:
@@ -33,11 +29,7 @@
   (let ((module-path (locate-module name)))
     (assert module-path (fmt #f "Failed to find module " name " in "
                              (get-module-paths)))
-    (if (member module-path +imported-modules+)
+    (read-public-interface module-path)))
-        (list)
-        (begin
-          (set! +imported-modules+ (cons module-path +imported-modules+))
-          (read-public-interface module-path)))))
 
 (define (get-module-paths)
   (cons (current-directory)
@@ -83,7 +75,7 @@
        ;; A variable becomes an `extern' declaration
        ((var)
         (cons (copy-form-source! form (cons 'extern (take (cdr form) 3))) acc))
-       ((define defmacro enum import include struct typedef union)
+       ((define defmacro 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)))

tests/codegen.scm

@@ -141,28 +141,6 @@ compiles."
     (test-assert "a comment in a body stays in the body"
       (emits? (in-fn "(while (< a b) ;; inside\n (g 1))")
               "while (a < b) {")))
-
-  (test-group "pub enum"
-    (test-assert "is emitted"
-      (emits? "(pub enum color (red green blue))" "enum color"))
-    (test-assert "with its values"
-      (emits? "(pub enum color (red green blue))" "red"))
-    (test-assert "and a non-pub enum still is too"
-      (emits? "(enum color (red green blue))" "enum color"))
-    ;; Naming an enum as a type, rather than defining it, had no
-    ;; walk-enum clause and died with `(match) no matching pattern'
-    (test-assert "and it can then be used as a type"
-      (emits? "(enum color (red green blue)) (fn f () void (var m (enum color) red))"
-              "enum color m = red"))
-    (test-assert "a malformed enum is rejected with its location"
-      (reports? "(enum)" "codegen.sex:1:"))
-    ;; c-type handed the declarator's name to c-enum as the enum tag,
-    ;; so this emitted `enum m { up, down }' with no variable at all
-    (test-assert "an anonymous enum keeps the variable"
-      (emits? "(fn f () void (var e (enum (up down)) up))" "} e = up"))
-    (test-assert "and a named definition keeps both"
-      (emits? "(fn f () void (var n (enum named (a b)) a))" "enum named{")))
-
   ;; `|', `||' and `|=' read as ordinary symbols -- our own reader has
   ;; no |symbol| syntax for them to collide with -- but fmt-c cannot
   ;; dispatch on a symbol whose name it cannot write in Scheme source,

tests/modules/Makefile

@@ -7,14 +7,10 @@
 # module's object survives being passed after `--'. Get any of them
 # wrong and this fails to link -- or, in the `pub var' case, links and
 # quietly counts into a private copy.
-#
-# It also checks what only a second translation unit can check: that an
-# imported type reaches the type database, by expanding a macro that
-# reads the imported struct's fields.
 
 SEXC ?= ../../sexc
 
-EXPECTED = hello, world\nhello, sex\n2 greetings\ntext times \ntext times \nmood 1
+EXPECTED = hello, world\nhello, sex\n2 greetings
 
 check:
 	@$(SEXC) greet.sex -c -o greet.o

tests/modules/greet-app.sex

@@ -7,9 +7,6 @@
 ;;; as a prototype and `greet-count' as an extern. Both keep external
 ;;; linkage, so they refer to the one definition in greet.o rather than
 ;;; to private copies.
-;;;
-;;; Also check that import populates type-database, by means of
-;;; describe-fields macro, which should work on imported type.
 
 (include stdio.h)
 
@@ -19,11 +16,4 @@
   (greet "world")
   (greet "sex")
   (printf "%d greetings\n" greet-count)
-  (describe-fields greeting)
-  (printf "\n")
-  ;; ...and through the imported typedef for it
-  (describe-fields greeting-t)
-  (printf "\n")
-  (var m (enum mood) grumpy)
-  (printf "mood %d\n" m)
   (return 0))

tests/modules/greet.sex

@@ -9,20 +9,6 @@
 
 (pub var greet-count int 0)
 
-(pub struct greeting ((text (* const char)) (times int)))
-
-(pub enum mood (cheerful grumpy))
-
-(pub typedef greeting-t (struct greeting))
-
-;;; Compile-time reflection across the module boundary: both the macro
-;;; and the struct it asks about are exported, and the importing unit
-;;; has to know the struct's fields to expand this.
-(pub defmacro (describe-fields type)
-  `(do ,@(map-fields type
-           (lambda (name field-type)
-             `(printf "%s " ,(symbol->string name))))))
-
 (pub fn greet ((name (* const char))) void
   (++ greet-count)
   (printf "hello, %s\n" name))

tests/types.scm

@@ -54,42 +54,6 @@
         #f
         (get-underlying-type 't-point))
 
-  ;; Reflection through an alias. Both spellings of the target occur:
-  ;; (typedef point-t point) and (typedef point-t (struct point)).
-  (add-typedef 't-point-t '(typedef t-point-t t-point))
-  (test "a typedef to a struct has the struct's fields"
-        '((x int) (y int))
-        (get-fields 't-point-t))
-  (add-typedef 't-point-s '(typedef t-point-s (struct t-point)))
-  (test "written the other way round too"
-        '((x int) (y int))
-        (get-fields 't-point-s))
-  (add-typedef 't-point-2 '(typedef t-point-2 t-point-t))
-  (test "and through a chain of them"
-        '((x int) (y int))
-        (get-fields 't-point-2))
-  (test "map-fields follows an alias as well"
-        '((x int) (y int))
-        (map-fields 't-point-t (lambda (name type) (list name type))))
-  (add-typedef 't-color-t '(typedef t-color-t t-color))
-  (test "an aliased enum is still named as it was declared"
-        '((red (enum t-color)) (green (enum t-color)) (blue (enum t-color)))
-        (map-fields 't-color-t (lambda (name type) (list name type))))
-  (test "a typedef to a primitive has no fields"
-        #f
-        (get-fields 't-u8))
-
-  ;; A typedef can be written to lead back to itself. Resolving it must
-  ;; stop rather than spin
-  (add-typedef 't-loop-a '(typedef t-loop-a t-loop-b))
-  (add-typedef 't-loop-b '(typedef t-loop-b t-loop-a))
-  (test "a typedef cycle terminates"
-        't-loop-a
-        (get-underlying-type 't-loop-a))
-  (test "and has no fields"
-        #f
-        (get-fields 't-loop-a))
-
   ;; A #define keeps its value forms -- there can be more than one.
   (add-define 't-maxn '(define t-maxn 8))
   (test "defines are recorded"

types.scm

@@ -76,44 +76,21 @@
 ;;; ((name type) ...) for a struct or union, #f for anything else --
 ;;; including a name that was never declared. Callers give the better
 ;;; error, since they know what they wanted it for.
-;;;
-;;; A typedef is followed to what it stands for, so reflection over an
-;;; alias works exactly as it does over the name it aliases.
 (define (get-fields name)
-  (let ((info (resolve-type-info name)))
+  (let ((info (get-type-info name)))
     (and info
          (memq (car info) '(struct union))
          (caddr info))))
 
-;;; Follow a typedef chain to the name it stands for. #f if NAME is
+;;; Follow a typedef chain to the name it ultimately stands for. #f if
-;;; not a typedef. A typedef that leads back to itself stops rather
+;;; NAME is not a typedef.
-;;; than spinning: nothing prevents one from being written.
 (define (get-underlying-type name)
-  (let follow ((name name) (seen (list)))
-    (and (not (member name seen))
-         (let ((info (get-type-info name)))
-           (and info
-                (eq? (car info) 'typedef)
-                (let ((target (caddr info)))
-                  (or (and (symbol? target) (follow target (cons name seen)))
-                      target)))))))
-
-;;; The declaration NAME ultimately names. For a typedef that is the
-;;; entry of whatever it stands for, and for anything else it is
-;;; NAME's own info.
-(define (resolve-type-info name)
   (let ((info (get-type-info name)))
     (and info
-         (if (eq? (car info) 'typedef)
+         (eq? (car info) 'typedef)
-             (let* ((target (get-underlying-type name))
+         (let ((target (caddr info)))
-                    (tag (cond ((symbol? target) target)
+           (or (and (symbol? target) (get-underlying-type target))
-                               ((and (pair? target)
+               target)))))
-                                     (pair? (cdr target))
-                                     (symbol? (cadr target)))
-                                (cadr target))
-                               (else #f))))
-               (and tag (get-type-info tag)))
-             info))))
 
 ;;; Type matcher macro
 ;;; (type-match type
@@ -142,16 +119,15 @@
 ;;;
 ;;; Returns #f if nothing of that name was declared
 (define (map-fields struct-union-enum fn)
-  (let ((info (resolve-type-info struct-union-enum)))
+  (let ((info (get-type-info struct-union-enum)))
     (and info
          (case (car info)
            ((struct union)
             (map (lambda (field) (fn (car field) (cadr field)))
                  (caddr info)))
-           ;; An enumerator's type is the enum itself -- named as it was
+           ;; An enumerator's type is the enum itself.
-           ;; declared, since `enum some-typedef' is not a C type.
            ((enum)
-            (let ((type (list 'enum (cadr info))))
+            (let ((type (list 'enum struct-union-enum)))
               (map (lambda (value) (fn value type))
                    (caddr info))))
            (else #f)))))