Merge pull request #698 from casselc/agent/ffi-struct-layouts

Add declarative FFI struct layouts

Author: yogthos

CHANGELOG.md

@@ -7,6 +7,16 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+### Added
+
+- **Declarative `jolt.ffi` struct layouts:** `(ffi/layout [:struct ...])`
+  compiles a literal, data-only descriptor into immutable ABI metadata derived
+  by Chez. `layout-size`, `layout-alignment`, and `field-offset` expose the
+  native layout, while `read-field` and `write-field` access scalar fields by
+  keyword path. Layouts support fixed-size scalar fields and nested structs;
+  arrays, unions, bitfields, packing, and recursive descriptors are not yet
+  supported.
+
 ### Fixed
 
 - **Static fields resolve through every access path.** Three related bugs in
@@ -130,7 +140,6 @@ the `var` special form reports real errors.
   namespaced symbol (the namespace part used to be dropped). `(var String)`
   still succeeds and returns the class-holding var — jolt keeps imported
   classes in vars, a deliberate superset of the JVM, which refuses.
-
 ## [0.7.21] - 2026-08-22
 
 A patch release that gives core vars their documentation: `(meta #'map)` used

Makefile

@@ -489,10 +489,12 @@ cts: testbin
 # FFI: bind native functions (typed foreign-procedure), memory, and that a
 # :blocking call is collect-safe (a parked thread doesn't pin the collector).
 # The widths gate covers the exact scalar vocabulary across both halves of the
-# API: runtime memory access and compiler-emitted procedures/callables.
+# API: runtime memory access and compiler-emitted procedures/callables. The
+# layout gate compares declarative struct metadata and field access against C.
 ffi:
 	@$(CHEZ) --script test/chez/ffi-binding-test.ss
 	@sh test/chez/ffi-widths-test.sh "$(CHEZ)"
+	@sh test/chez/ffi-layout-test.sh "$(CHEZ)"
 
 # Transients: mutable backing, snapshot on persistent!, and linear-time builds.
 transient:

host/chez/seed/image.ss

@@ -899,6 +899,75 @@
   (host-new (or (deftype-ctor-class ctx class) class)
             (mapv #(analyze ctx % env) args)))
 
+;; Literal, data-only struct descriptors. Keep the analyzer representation free
+;; of reader objects so it survives self-hosting and can be embedded in the IR.
+(def ^:private ffi-layout-scalars
+  #{"int" "uint" "int8" "i8" "uint8" "u8" "byte" "char"
+    "int16" "short" "uint16" "ushort" "int32" "uint32"
+    "long" "ulong" "int64" "uint64" "size_t" "ssize_t" "iptr" "uptr"
+    "double" "float" "pointer" "void*"})
+
+(declare analyze-ffi-layout-type)
+
+(defn- analyze-ffi-layout-struct [form]
+  (when-not (form-vec? form)
+    (throw (str "jolt.ffi layout descriptor must be [:struct [[field type] ...]], got "
+                (pr-str form))))
+  (let [parts (vec (form-vec-items form))]
+    (when-not (and (= 2 (count parts))
+                   (form-keyword? (nth parts 0))
+                   (nil? (namespace (nth parts 0)))
+                   (= "struct" (name (nth parts 0)))
+                   (form-vec? (nth parts 1)))
+      (throw (str "jolt.ffi layout descriptor must be [:struct [[field type] ...]], got "
+                  (pr-str form))))
+    (let [field-forms (vec (form-vec-items (nth parts 1)))]
+      (when (empty? field-forms)
+        (throw "jolt.ffi struct descriptor must contain at least one field"))
+      (loop [remaining field-forms names #{} fields []]
+        (if (empty? remaining)
+          {:ffi-kind :struct :fields fields}
+          (let [field (first remaining)]
+            (when-not (form-vec? field)
+              (throw (str "jolt.ffi struct field must be [keyword type], got "
+                          (pr-str field))))
+            (let [fp (vec (form-vec-items field))]
+              (when-not (= 2 (count fp))
+                (throw (str "jolt.ffi struct field must be [keyword type], got "
+                            (pr-str field))))
+              (let [field-name (nth fp 0)]
+                (when-not (and (form-keyword? field-name)
+                               (nil? (namespace field-name)))
+                  (throw (str "jolt.ffi struct field name must be an unqualified keyword, got "
+                              (pr-str field-name))))
+                (let [nm (name field-name)]
+                  (when (contains? names nm)
+                    (throw (str "jolt.ffi struct field names must be unique; duplicate :" nm)))
+                  (recur (rest remaining)
+                         (conj names nm)
+                         (conj fields {:name nm
+                                       :type (analyze-ffi-layout-type (nth fp 1))})))))))))))
+
+(defn- analyze-ffi-layout-type [form]
+  (cond
+    (form-keyword? form)
+    (let [n (name form)]
+      (when-not (and (nil? (namespace form)) (contains? ffi-layout-scalars n))
+        (throw (str "jolt.ffi struct field type must be a fixed-size scalar or nested struct; got "
+                    (pr-str form))))
+      n)
+
+    (form-vec? form) (analyze-ffi-layout-struct form)
+
+    :else
+    (throw (str "jolt.ffi struct field type must be a fixed-size scalar or nested struct; got "
+                (pr-str form)))))
+
+(defn- analyze-ffi-layout [items]
+  (when-not (= 2 (count items))
+    (throw "jolt.ffi/layout expects one literal struct descriptor"))
+  {:op :ffi-layout :layout (analyze-ffi-layout-struct (nth items 1))})
+
 ;; jolt.ffi/__cfn: the low-level foreign-function form a jolt library
 ;; uses (via the jolt.ffi/foreign-fn macro) to bind native code. Shape:
 ;;   (jolt.ffi/__cfn "c_symbol" [:argtype ...] :rettype)            ; non-blocking
@@ -1235,6 +1304,11 @@
           (and (form-sym? head) (= "jolt.ffi" (form-sym-ns head))
                (= "__cfn" (form-sym-name head)))
             (analyze-ffi-fn ctx items env)
+          ;; jolt.ffi/layout expands to this literal-only leaf. The back end
+          ;; asks Chez for the actual ABI size, alignment and offsets.
+          (and (form-sym? head) (= "jolt.ffi" (form-sym-ns head))
+               (= "__layout" (form-sym-name head)))
+            (analyze-ffi-layout items)
           ;; jolt.ffi/__ccallable — the foreign-callback special form (the fn is a
           ;; child expression, analyzed here).
           (and (form-sym? head) (= "jolt.ffi" (form-sym-ns head))

host/gambit/seed/image.ss

@@ -1138,6 +1138,92 @@
    "uint8" "unsigned-8" "u8" "unsigned-8" "byte" "unsigned-8" "char" "char"})
 (defn- ffi-type->chez [t]
   (or (ffi-types t) (throw (ex-info (str "jolt.ffi: unknown foreign type :" t) {}))))
+
+(defn- emit-ffi-layout-ftype [layout]
+  (str "(struct "
+       (str/join
+        " "
+        (map-indexed
+         (fn [i field]
+           (str "[f" i " "
+                (if (string? (:type field))
+                  (ffi-type->chez (:type field))
+                  (emit-ffi-layout-ftype (:type field)))
+                "]"))
+         (:fields layout)))
+       ")"))
+
+(defn- ffi-layout-entries
+  ([layout] (ffi-layout-entries layout [] []))
+  ([layout public-path emitted-path]
+   (mapcat
+    (fn [i field]
+      (let [pp (conj public-path (:name field))
+            ep (conj emitted-path (str "f" i))
+            entry {:path pp :emitted-path ep :type (:type field)}]
+        (if (string? (:type field))
+          [entry]
+          (cons entry (ffi-layout-entries (:type field) pp ep)))))
+    (range (count (:fields layout)))
+    (:fields layout))))
+
+(defn- emit-layout-path [path]
+  (str "(jolt-vector "
+       (str/join " " (map (fn [n] (str "(keyword #f " (chez-str-lit n) ")")) path))
+       ")"))
+
+(defn- emit-layout-descriptor [layout]
+  (str "(jolt-vector (keyword #f \"struct\") (jolt-vector "
+       (str/join
+        " "
+        (map (fn [field]
+               (str "(jolt-vector (keyword #f " (chez-str-lit (:name field)) ") "
+                    (if (string? (:type field))
+                      (str "(keyword #f " (chez-str-lit (:type field)) ")")
+                      (emit-layout-descriptor (:type field)))
+                    ")"))
+             (:fields layout)))
+       "))"))
+
+(defn- emit-ffi-layout [node]
+  (let [layout (:layout node)
+        type-name (fresh-label "jolt_ffi_layout")
+        align-name (fresh-label "jolt_ffi_layout_align")
+        entries (vec (ffi-layout-entries layout))
+        base (str "(make-ftype-pointer " type-name " 0)")
+        offsets
+        (str "(jolt-hash-map "
+             (str/join
+              " "
+              (map (fn [entry]
+                     (str (emit-layout-path (:path entry)) " "
+                          "(ftype-pointer-address (ftype-&ref " type-name " ("
+                          (str/join " " (:emitted-path entry)) ") " base "))"))
+                   entries))
+             ")")
+        types
+        (str "(jolt-hash-map "
+             (str/join
+              " "
+              (keep (fn [entry]
+                      (when (string? (:type entry))
+                        (str (emit-layout-path (:path entry)) " "
+                             "(keyword #f " (chez-str-lit (:type entry)) ")")))
+                    entries))
+             ")")]
+    (str "(let () "
+         "(define-ftype " type-name " " (emit-ffi-layout-ftype layout) ") "
+         "(define-ftype " align-name " (struct [prefix unsigned-8] [value " type-name "])) "
+         "(jolt-hash-map "
+         "(keyword \"jolt.ffi\" \"layout\") #t "
+         "(keyword #f \"descriptor\") " (emit-layout-descriptor layout) " "
+         "(keyword #f \"size\") (ftype-sizeof " type-name ") "
+         "(keyword #f \"alignment\") "
+         "(ftype-pointer-address (ftype-&ref " align-name " (value) "
+         "(make-ftype-pointer " align-name " 0))) "
+         "(keyword \"jolt.ffi\" \"offsets\") " offsets " "
+         "(keyword \"jolt.ffi\" \"types\") " types "))")))
+
 (defn- emit-ffi-fn [node]
   ;; A "varargs" marker in the argtype vector declares the binding variadic and
   ;; marks the FIXED/VARIADIC boundary: types before it are the named
@@ -2171,6 +2257,7 @@
     :let (emit-let node)
     :loop (emit-loop node)
     :recur (emit-recur node)
+    :ffi-layout (emit-ffi-layout node)
     :ffi-fn (emit-ffi-fn node)
     :ffi-callable (emit-ffi-callable node)
     :fn (emit-fn node)

jolt-core/jolt/analyzer.clj

@@ -135,6 +135,7 @@
 ;; :set-var      :the-var :val                    :val   (:the-var is a leaf the-var node)
 ;; :set-field    :obj :field :val                 :obj :val
 ;; :defmacro     :ns :name :fn                     :fn
+;; :ffi-layout   :layout                           —
 ;; :ffi-fn       :csym :argtypes :rettype         —
 ;; :ffi-callable :fn :argtypes :rettype           :fn
 ;; :regex        :source                          —
@@ -164,7 +165,7 @@
 (def node-ops
   #{:const :local :var :the-var :host :host-static :host-new :if :do :invoke :def
     :let :loop :recur :fn :vector :map :set :quote :throw :coerce :try :host-call
-    :set-var :set-field :defmacro :ffi-fn :ffi-callable :regex :inst :uuid :bigdec
+    :set-var :set-field :defmacro :ffi-layout :ffi-fn :ffi-callable :regex :inst :uuid :bigdec
     :the-ns})
 
 ;; op -> the keys a node of that op must carry. Optional keys (:init, annotations)
@@ -179,6 +180,7 @@
    :throw [:expr] :coerce [:kind :expr] :try [:body]
    :host-call [:target :method :args] :set-var [:the-var :val]
    :set-field [:obj :field :val] :defmacro [:ns :name :fn]
+   :ffi-layout [:layout]
    :ffi-fn [:csym :argtypes :rettype] :ffi-callable [:fn :argtypes :rettype]
    :regex [:source] :inst [:source] :uuid [:source] :bigdec [:source]
    :the-ns [:name]})

jolt-core/jolt/backend_scheme.clj

@@ -40,6 +40,54 @@
   is the inverse — it wraps a jolt fn as a C-callable function pointer so C can
   call back into jolt (e.g. GTK signal handlers); free-callable releases it.")
 
+(defmacro layout
+  "Compile a literal [:struct [[field type] ...]] descriptor into immutable ABI
+  layout data. Field names are unique unqualified keywords; fields are fixed-size
+  scalars or nested structs. Chez supplies size, alignment, and offsets."
+  [descriptor]
+  (list 'jolt.ffi/__layout descriptor))
+
+(defn- checked-layout [layout]
+  (when-not (and (map? layout) (= true (:jolt.ffi/layout layout)))
+    (throw (ex-info "jolt.ffi: expected a compiled layout" {:layout layout})))
+  layout)
+
+(defn- checked-field-path [path]
+  (let [p (if (keyword? path) [path] path)]
+    (when-not (and (vector? p) (pos? (count p))
+                   (every? #(and (keyword? %) (nil? (namespace %))) p))
+      (throw (ex-info "jolt.ffi: field path must be an unqualified keyword or non-empty vector of them"
+                      {:path path})))
+    p))
+
+(defn layout-size [layout] (:size (checked-layout layout)))
+(defn layout-alignment [layout] (:alignment (checked-layout layout)))
+
+(defn field-offset [layout path]
+  (let [layout (checked-layout layout)
+        path (checked-field-path path)
+        offsets (:jolt.ffi/offsets layout)]
+    (when-not (contains? offsets path)
+      (throw (ex-info "jolt.ffi: unknown layout field path" {:path path})))
+    (get offsets path)))
+
+(defn- field-type [layout path]
+  (let [types (:jolt.ffi/types layout)]
+    (when-not (contains? types path)
+      (throw (ex-info "jolt.ffi: field path names a struct, not a scalar field"
+                      {:path path})))
+    (get types path)))
+
+(defn read-field [pointer layout path]
+  (let [layout (checked-layout layout)
+        path (checked-field-path path)]
+    (jolt.ffi/read pointer (field-type layout path) (field-offset layout path))))
+
+(defn write-field [pointer layout path value]
+  (let [layout (checked-layout layout)
+        path (checked-field-path path)]
+    (jolt.ffi/write pointer (field-type layout path) (field-offset layout path) value)))
+
 ;; foreign-fn binds C symbol `csym` to a typed callable. Expands to the __cfn
 ;; special form (always fully-qualified, so an :as alias on jolt.ffi resolves):
 ;; the analyzer/back end turn it into a Chez foreign-procedure.

jolt-core/jolt/ir.clj

@@ -0,0 +1,46 @@
+/* C ABI witnesses for declarative jolt.ffi layouts. */
+#include <stddef.h>
+#include <stdint.h>
+
+#ifdef _WIN32
+#define JOLT_LAYOUT_EXPORT __declspec(dllexport)
+#else
+#define JOLT_LAYOUT_EXPORT __attribute__((visibility("default")))
+#endif
+
+struct jolt_layout_flat {
+  int32_t year;
+  uint8_t month;
+  uint8_t day;
+};
+
+struct jolt_layout_padded {
+  uint8_t tag;
+  double value;
+  uint16_t tail;
+};
+
+struct jolt_layout_nested {
+  uint8_t tag;
+  struct jolt_layout_flat date;
+  uint16_t tail;
+};
+
+#define WITNESS(name, expr) \
+  JOLT_LAYOUT_EXPORT size_t jolt_layout_##name(void) { return (expr); }
+
+WITNESS(flat_size, sizeof(struct jolt_layout_flat))
+WITNESS(flat_align, _Alignof(struct jolt_layout_flat))
+WITNESS(flat_year, offsetof(struct jolt_layout_flat, year))
+WITNESS(flat_month, offsetof(struct jolt_layout_flat, month))
+WITNESS(flat_day, offsetof(struct jolt_layout_flat, day))
+WITNESS(padded_size, sizeof(struct jolt_layout_padded))
+WITNESS(padded_align, _Alignof(struct jolt_layout_padded))
+WITNESS(padded_value, offsetof(struct jolt_layout_padded, value))
+WITNESS(padded_tail, offsetof(struct jolt_layout_padded, tail))
+WITNESS(nested_size, sizeof(struct jolt_layout_nested))
+WITNESS(nested_align, _Alignof(struct jolt_layout_nested))
+WITNESS(nested_date, offsetof(struct jolt_layout_nested, date))
+WITNESS(nested_year, offsetof(struct jolt_layout_nested, date.year))
+WITNESS(nested_month, offsetof(struct jolt_layout_nested, date.month))
+WITNESS(nested_tail, offsetof(struct jolt_layout_nested, tail))

stdlib/jolt/ffi.clj

@@ -0,0 +1,42 @@
+#!/bin/sh
+# Build the struct-layout C witness outside the tree, run the compiler-level and
+# public API checks, and retain the complete temporary directory on failure.
+set -u
+
+CHEZ=${1-}
+[ -n "$CHEZ" ] || { echo "usage: $0 <chez> [jolt]" >&2; exit 2; }
+JOLT=${2-bin/jolt}
+C=test/chez/ffi-layout-helper.c
+[ -f "$C" ] || { echo "missing $C (run from repo root)" >&2; exit 2; }
+[ -x "$JOLT" ] || { echo "missing executable jolt: $JOLT" >&2; exit 2; }
+
+OUT=$(mktemp -d) || exit 1
+[ -n "$OUT" ] && [ -d "$OUT" ] || {
+  echo "mktemp returned no usable ffi-layout artifact directory" >&2
+  exit 1
+}
+case "$(uname -s)" in
+  Darwin) EXT=dylib ;;
+  MINGW*|MSYS*|CYGWIN*) EXT=dll ;;
+  *) EXT=so ;;
+esac
+SO=$OUT/jolt-ffi-layout-helper.$EXT
+cleanup() {
+  status=$?
+  if [ "$status" -eq 0 ]; then
+    rm -f "$SO"
+    rmdir "$OUT"
+  else
+    echo "retained ffi-layout artifacts: $OUT" >&2
+  fi
+}
+trap cleanup EXIT
+CC_BIN=${CC:-cc}
+case "$(uname -s)" in
+  Darwin) "$CC_BIN" -std=c11 -dynamiclib -o "$SO" "$C" ;;
+  MINGW*|MSYS*|CYGWIN*) "$CC_BIN" -std=c11 -shared -o "$SO" "$C" ;;
+  *) "$CC_BIN" -std=c11 -shared -fPIC -o "$SO" "$C" ;;
+esac || { echo "cc failed to build $C" >&2; exit 1; }
+JOLT_FFI_LAYOUT_HELPER=$SO "$CHEZ" --script test/chez/ffi-layout-test.ss
+JOLT_NO_USER_DEPS=1 JOLT_FFI_LAYOUT_HELPER=$SO \
+  "$JOLT" run test/chez/jolt-ffi-layout-test.clj