From 0a1911862f969d33fafb22c3f6112998b8b310da Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 19 Feb 2026 11:08:20 +0000 Subject: [PATCH] Expose explicit C interface We drop the tools specifically designed for Haskell and Rust together, in favour of general tools for using each with C. Namely, we use Mozilla's `cbindgen` for generating header files from the Rust source, and Well-Typed's new `hs-bindgen` tool for generating Haskell from those header files. The Rust code here is essentially the result of expanding the old macro, then inlining and renaming internals. The most important thing here is that we're now relying solely on robust well-maintained tools. --- cabal.project | 23 ++ generate-bindings | 128 +++++++ haskell/exe/Main.hs | 9 +- haskell/garnet.cabal | 22 +- haskell/generated/GarnetRs.hs | 476 +++++++++++++++++++++++++++ haskell/generated/GarnetRs/FunPtr.hs | 47 +++ haskell/generated/GarnetRs/Safe.hs | 48 +++ haskell/generated/GarnetRs/Unsafe.hs | 48 +++ rust/Cargo.lock | 212 ------------ rust/Cargo.toml | 3 - rust/garnet_rs.h | 6 + rust/hsbindgen.toml | 13 - rust/lib.rs | 10 +- 13 files changed, 804 insertions(+), 241 deletions(-) create mode 100755 generate-bindings create mode 100644 haskell/generated/GarnetRs.hs create mode 100644 haskell/generated/GarnetRs/FunPtr.hs create mode 100644 haskell/generated/GarnetRs/Safe.hs create mode 100644 haskell/generated/GarnetRs/Unsafe.hs create mode 100644 rust/garnet_rs.h delete mode 100644 rust/hsbindgen.toml diff --git a/cabal.project b/cabal.project index 9eae6eb..b98686e 100644 --- a/cabal.project +++ b/cabal.project @@ -1,5 +1,28 @@ packages: haskell +-- TODO a total hack +package garnet + extra-lib-dirs: + /home/gthomas/code/garnet/rust/target/release + /home/gthomas/code/garnet/rust/target/debug + extra-include-dirs: + /home/gthomas/code/garnet/rust + +-- https://well-typed.com/blog/2026/02/hs-bindgen-alpha +-- Haskell.nix doesn't seem to like `tag: release-0.1-alpha`, which the blog post suggests +-- so we specify the equivalent commit SHAs manually instead +source-repository-package + type: git + location: https://github.com/well-typed/hs-bindgen + tag: e2a9260678d9fa76dab602a5a07927acada3be4f + subdir: c-expr-dsl c-expr-runtime hs-bindgen hs-bindgen-runtime + --sha256: 0nrs3iq0l5ha5kxyhqnlmvgi7734pmzyp3zf7p8s1gb21ylh4sy0 +source-repository-package + type: git + location: https://github.com/well-typed/libclang + tag: b5ff712c91c039cde6720ffe2096a121d9f4d802 + --sha256: 1lwjdxd2ahhkvyxrpli7z9z7ss4l94m2jaif8kg1i2yygbhksrb3 + allow-newer: *:base, *:containers, diff --git a/generate-bindings b/generate-bindings new file mode 100755 index 0000000..30d4b1b --- /dev/null +++ b/generate-bindings @@ -0,0 +1,128 @@ +#!/usr/bin/env bash +set -euo pipefail + +# TODO this is a complete vibe-coded hack, but the header patching at least is crucial + +# Generate Haskell FFI bindings from Rust source code. +# +# Pipeline: cargo build -> cbindgen -> patch header -> hs-bindgen +# +# Prerequisites: run inside the Nix dev shell (provides gcc, cabal, etc.) +# cbindgen is fetched via `nix run nixpkgs#rust-cbindgen`. + +SCRIPT_DIR="$(cd "$(dirname "$0")" && pwd)" +RUST_DIR="$SCRIPT_DIR/rust" +HASKELL_DIR="$SCRIPT_DIR/haskell" +HEADER_NAME="garnet_rs.h" +HEADER="$RUST_DIR/$HEADER_NAME" + +# --- Step 1: Build Rust static library --- +echo "=== Building Rust library ===" +cargo build --manifest-path "$RUST_DIR/Cargo.toml" + +# --- Step 2: Generate C header with cbindgen --- +echo "=== Running cbindgen ===" +nix run nixpkgs#rust-cbindgen -- \ + --lang c \ + --crate garnet-rs \ + --output "$HEADER" \ + "$RUST_DIR" + +echo " Raw header written to $HEADER" + +# --- Step 3: Patch the header for hs-bindgen compatibility --- +echo "=== Patching header ===" + +# Two patches are needed: +# +# Patch 1: Replace cbindgen's enum pattern with typedef + #defines. +# cbindgen emits: enum Shape_Tag { Circle, Rectangle, }; typedef uint8_t Shape_Tag; +# hs-bindgen needs: typedef uint8_t Shape_Tag; #define Circle 0 ... +# +# Patch 2: Name anonymous unions inside structs. +# cbindgen emits: union { ... }; +# hs-bindgen needs: union { ... } body; + +awk ' +# State machine for enum->typedef+define transformation +/^enum [A-Za-z_][A-Za-z0-9_]* \{$/ { + in_enum = 1 + enum_name = $2 + variant_count = 0 + delete variants + next +} +in_enum && /^\};$/ { + # Next line should be: typedef ; + in_enum = 0 + pending_enum = 1 + next +} +in_enum { + # Collect variant names (strip trailing comma and whitespace) + v = $0 + gsub(/^[[:space:]]+/, "", v) + gsub(/,[[:space:]]*$/, "", v) + if (v != "") { + variants[variant_count] = v + variant_count++ + } + next +} +pending_enum && /^typedef [A-Za-z0-9_]+ / { + # Emit: typedef ; then #define for each variant + print $0 + for (i = 0; i < variant_count; i++) { + printf "#define %s %d\n", variants[i], i + } + pending_enum = 0 + next +} + +# Name anonymous unions: }; at end of union block inside struct -> } body; +/^ \};$/ && saw_union { + print " } body;" + saw_union = 0 + next +} +/^ union \{$/ { + saw_union = 1 +} + +{ print } +' "$HEADER" > "${HEADER}.tmp" && mv "${HEADER}.tmp" "$HEADER" + +echo " Patched header at $HEADER" + +# --- Step 4: Derive system include paths for hs-bindgen's libclang --- +echo "=== Detecting system include paths ===" + +# hs-bindgen uses libclang directly, which doesn't know about NixOS's +# non-standard include locations. We extract them from cpp -v and pass +# all of them — extra paths are harmless. +CLANG_OPTIONS=() +while IFS= read -r dir; do + CLANG_OPTIONS+=("--clang-option" "-isystem$dir") +done < <(echo | cpp -v 2>&1 | awk '/#include <\.\.\.> search starts here:/{f=1;next}/End of search list/{f=0}f{gsub(/^ +/,"");print}') + +if [ ${#CLANG_OPTIONS[@]} -eq 0 ]; then + echo " WARNING: No system include paths detected. hs-bindgen may fail." +else + echo " Found ${#CLANG_OPTIONS[@]} clang options:" + for ((i=0; i<${#CLANG_OPTIONS[@]}; i+=2)); do + echo " ${CLANG_OPTIONS[i+1]}" + done +fi + +# --- Step 5: Run hs-bindgen --- +echo "=== Running hs-bindgen ===" +cabal run -- hs-bindgen-cli preprocess \ + --overwrite-files --create-output-dirs \ + --unique-id com.garnet --enable-record-dot \ + --hs-output-dir "$HASKELL_DIR/generated" --module GarnetRs \ + "${CLANG_OPTIONS[@]}" \ + -I "$RUST_DIR" "$HEADER_NAME" + +echo "=== Done ===" +echo "Generated Haskell bindings in $HASKELL_DIR/generated/" +echo "Run 'cabal run garnet' to test." diff --git a/haskell/exe/Main.hs b/haskell/exe/Main.hs index 69d00ee..de97264 100644 --- a/haskell/exe/Main.hs +++ b/haskell/exe/Main.hs @@ -1,8 +1,9 @@ module Main (main) where -import Foreign.C.String (CString, withCString) - -foreign import ccall safe "__c_hello" hello :: CString -> IO () +import Foreign.C +import GarnetRs.Safe +import HsBindgen.Runtime.PtrConst main :: IO () -main = withCString "Haskell" hello +main = do + withCString "Haskell" $ hello . unsafeFromPtr diff --git a/haskell/garnet.cabal b/haskell/garnet.cabal index 0ccb29b..d07f408 100644 --- a/haskell/garnet.cabal +++ b/haskell/garnet.cabal @@ -7,6 +7,20 @@ maintainer: george.thomas@obsidian.systems patrick.aldis@obsidian.systems +library garnet-generated + hs-source-dirs: generated + exposed-modules: + GarnetRs + GarnetRs.Safe + GarnetRs.Unsafe + GarnetRs.FunPtr + default-language: Haskell2010 + extra-bundled-libraries: garnet_rs + build-depends: + base, + hs-bindgen-runtime, + primitive, + executable garnet main-is: Main.hs hs-source-dirs: exe @@ -32,11 +46,7 @@ executable garnet -threaded -rtsopts -with-rtsopts=-N - extra-lib-dirs: - -- TODO referring to parent triggers warning - maybe put Rust stuff in subdir - -- TODO bit weird to have both of these, but it's what the `cargo-cabal` setup script did - ../rust/target/release - ../rust/target/debug - extra-bundled-libraries: garnet_rs build-depends: base >= 4.14, + garnet-generated, + hs-bindgen-runtime, diff --git a/haskell/generated/GarnetRs.hs b/haskell/generated/GarnetRs.hs new file mode 100644 index 0000000..07ba5b8 --- /dev/null +++ b/haskell/generated/GarnetRs.hs @@ -0,0 +1,476 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UndecidableInstances #-} + +module GarnetRs where + +import qualified Data.Array.Byte +import qualified Data.Bits as Bits +import qualified Data.Ix as Ix +import qualified Data.Primitive.Types +import qualified Data.Proxy +import qualified Foreign as F +import qualified Foreign.C as FC +import qualified GHC.Generics +import qualified GHC.Ptr as Ptr +import qualified GHC.Records +import qualified HsBindgen.Runtime.HasCField +import qualified HsBindgen.Runtime.Internal.Bitfield +import qualified HsBindgen.Runtime.Internal.ByteArray +import qualified HsBindgen.Runtime.Internal.HasFFIType +import qualified HsBindgen.Runtime.Internal.SizedByteArray +import qualified HsBindgen.Runtime.LibC +import qualified HsBindgen.Runtime.Marshal +import Data.Bits (FiniteBits) +import HsBindgen.Runtime.Internal.TypeEquality (TyEq) +import Prelude ((<*>), (>>), Bounded, Enum, Eq, Int, Integral, Num, Ord, Read, Real, Show, pure) + +{-| __C declaration:__ @struct T@ + + __defined at:__ @garnet_rs.h 6:16@ + + __exported by:__ @garnet_rs.h@ +-} +data T = T + { a :: FC.CBool + {- ^ __C declaration:__ @a@ + + __defined at:__ @garnet_rs.h 7:8@ + + __exported by:__ @garnet_rs.h@ + -} + , b :: HsBindgen.Runtime.LibC.Word8 + {- ^ __C declaration:__ @b@ + + __defined at:__ @garnet_rs.h 8:11@ + + __exported by:__ @garnet_rs.h@ + -} + } + deriving stock (GHC.Generics.Generic) + deriving stock (Eq, Show) + +instance HsBindgen.Runtime.Marshal.StaticSize T where + + staticSizeOf = \_ -> (2 :: Int) + + staticAlignment = \_ -> (1 :: Int) + +instance HsBindgen.Runtime.Marshal.ReadRaw T where + + readRaw = + \ptr0 -> + pure T + <*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"a") ptr0 + <*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"b") ptr0 + +instance HsBindgen.Runtime.Marshal.WriteRaw T where + + writeRaw = + \ptr0 -> + \s1 -> + case s1 of + T a2 b3 -> + HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"a") ptr0 a2 + >> HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"b") ptr0 b3 + +deriving via HsBindgen.Runtime.Marshal.EquivStorable T instance F.Storable T + +instance HsBindgen.Runtime.HasCField.HasCField T "a" where + + type CFieldType T "a" = FC.CBool + + offset# = \_ -> \_ -> 0 + +instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType T) "a") + ) => GHC.Records.HasField "a" (Ptr.Ptr T) (Ptr.Ptr ty) where + + getField = + HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"a") + +instance HsBindgen.Runtime.HasCField.HasCField T "b" where + + type CFieldType T "b" = HsBindgen.Runtime.LibC.Word8 + + offset# = \_ -> \_ -> 1 + +instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType T) "b") + ) => GHC.Records.HasField "b" (Ptr.Ptr T) (Ptr.Ptr ty) where + + getField = + HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"b") + +{-| __C declaration:__ @Shape_Tag@ + + __defined at:__ @garnet_rs.h 11:17@ + + __exported by:__ @garnet_rs.h@ +-} +newtype Shape_Tag = Shape_Tag + { unwrap :: HsBindgen.Runtime.LibC.Word8 + } + deriving stock (GHC.Generics.Generic) + deriving stock (Eq, Ord, Read, Show) + deriving newtype + ( HsBindgen.Runtime.Marshal.StaticSize + , HsBindgen.Runtime.Marshal.ReadRaw + , HsBindgen.Runtime.Marshal.WriteRaw + , F.Storable + , HsBindgen.Runtime.Internal.HasFFIType.HasFFIType + , Data.Primitive.Types.Prim + , HsBindgen.Runtime.Internal.Bitfield.Bitfield + , Bits.Bits + , Bounded + , Enum + , FiniteBits + , Integral + , Ix.Ix + , Num + , Real + ) + +instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Shape_Tag) "unwrap") + ) => GHC.Records.HasField "unwrap" (Ptr.Ptr Shape_Tag) (Ptr.Ptr ty) where + + getField = + HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"unwrap") + +instance HsBindgen.Runtime.HasCField.HasCField Shape_Tag "unwrap" where + + type CFieldType Shape_Tag "unwrap" = + HsBindgen.Runtime.LibC.Word8 + + offset# = \_ -> \_ -> 0 + +{-| __C declaration:__ @Circle@ + + __defined at:__ @garnet_rs.h 12:9@ + + __exported by:__ @garnet_rs.h@ +-} +circle :: FC.CInt +circle = (0 :: FC.CInt) + +{-| __C declaration:__ @Rectangle@ + + __defined at:__ @garnet_rs.h 13:9@ + + __exported by:__ @garnet_rs.h@ +-} +rectangle :: FC.CInt +rectangle = (1 :: FC.CInt) + +{-| __C declaration:__ @struct Circle_Body@ + + __defined at:__ @garnet_rs.h 15:16@ + + __exported by:__ @garnet_rs.h@ +-} +data Circle_Body = Circle_Body + { radius :: FC.CDouble + {- ^ __C declaration:__ @radius@ + + __defined at:__ @garnet_rs.h 16:10@ + + __exported by:__ @garnet_rs.h@ + -} + } + deriving stock (GHC.Generics.Generic) + deriving stock (Eq, Show) + +instance HsBindgen.Runtime.Marshal.StaticSize Circle_Body where + + staticSizeOf = \_ -> (8 :: Int) + + staticAlignment = \_ -> (8 :: Int) + +instance HsBindgen.Runtime.Marshal.ReadRaw Circle_Body where + + readRaw = + \ptr0 -> + pure Circle_Body + <*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"radius") ptr0 + +instance HsBindgen.Runtime.Marshal.WriteRaw Circle_Body where + + writeRaw = + \ptr0 -> + \s1 -> + case s1 of + Circle_Body radius2 -> + HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"radius") ptr0 radius2 + +deriving via HsBindgen.Runtime.Marshal.EquivStorable Circle_Body instance F.Storable Circle_Body + +instance HsBindgen.Runtime.HasCField.HasCField Circle_Body "radius" where + + type CFieldType Circle_Body "radius" = FC.CDouble + + offset# = \_ -> \_ -> 0 + +instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Circle_Body) "radius") + ) => GHC.Records.HasField "radius" (Ptr.Ptr Circle_Body) (Ptr.Ptr ty) where + + getField = + HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"radius") + +{-| __C declaration:__ @struct Rectangle_Body@ + + __defined at:__ @garnet_rs.h 19:16@ + + __exported by:__ @garnet_rs.h@ +-} +data Rectangle_Body = Rectangle_Body + { width :: FC.CDouble + {- ^ __C declaration:__ @width@ + + __defined at:__ @garnet_rs.h 20:10@ + + __exported by:__ @garnet_rs.h@ + -} + , height :: FC.CDouble + {- ^ __C declaration:__ @height@ + + __defined at:__ @garnet_rs.h 21:10@ + + __exported by:__ @garnet_rs.h@ + -} + } + deriving stock (GHC.Generics.Generic) + deriving stock (Eq, Show) + +instance HsBindgen.Runtime.Marshal.StaticSize Rectangle_Body where + + staticSizeOf = \_ -> (16 :: Int) + + staticAlignment = \_ -> (8 :: Int) + +instance HsBindgen.Runtime.Marshal.ReadRaw Rectangle_Body where + + readRaw = + \ptr0 -> + pure Rectangle_Body + <*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"width") ptr0 + <*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"height") ptr0 + +instance HsBindgen.Runtime.Marshal.WriteRaw Rectangle_Body where + + writeRaw = + \ptr0 -> + \s1 -> + case s1 of + Rectangle_Body width2 height3 -> + HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"width") ptr0 width2 + >> HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"height") ptr0 height3 + +deriving via HsBindgen.Runtime.Marshal.EquivStorable Rectangle_Body instance F.Storable Rectangle_Body + +instance HsBindgen.Runtime.HasCField.HasCField Rectangle_Body "width" where + + type CFieldType Rectangle_Body "width" = FC.CDouble + + offset# = \_ -> \_ -> 0 + +instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Rectangle_Body) "width") + ) => GHC.Records.HasField "width" (Ptr.Ptr Rectangle_Body) (Ptr.Ptr ty) where + + getField = + HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"width") + +instance HsBindgen.Runtime.HasCField.HasCField Rectangle_Body "height" where + + type CFieldType Rectangle_Body "height" = FC.CDouble + + offset# = \_ -> \_ -> 8 + +instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Rectangle_Body) "height") + ) => GHC.Records.HasField "height" (Ptr.Ptr Rectangle_Body) (Ptr.Ptr ty) where + + getField = + HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"height") + +{-| __C declaration:__ @union \@Shape_body@ + + __defined at:__ @garnet_rs.h 26:3@ + + __exported by:__ @garnet_rs.h@ +-} +newtype Shape_body = Shape_body + { unwrap :: Data.Array.Byte.ByteArray + } + deriving stock (GHC.Generics.Generic) + +deriving via (HsBindgen.Runtime.Internal.SizedByteArray.SizedByteArray 16) 8 instance HsBindgen.Runtime.Marshal.StaticSize Shape_body + +deriving via (HsBindgen.Runtime.Internal.SizedByteArray.SizedByteArray 16) 8 instance HsBindgen.Runtime.Marshal.ReadRaw Shape_body + +deriving via (HsBindgen.Runtime.Internal.SizedByteArray.SizedByteArray 16) 8 instance HsBindgen.Runtime.Marshal.WriteRaw Shape_body + +deriving via HsBindgen.Runtime.Marshal.EquivStorable Shape_body instance F.Storable Shape_body + +{-| + + __See:__ 'set_shape_body_circle' + +__C declaration:__ @circle@ + +__defined at:__ @garnet_rs.h 27:17@ + +__exported by:__ @garnet_rs.h@ +-} +get_shape_body_circle :: + Shape_body + -> Circle_Body +get_shape_body_circle = + HsBindgen.Runtime.Internal.ByteArray.getUnionPayload + +{-| + + __See:__ 'get_shape_body_circle' + +-} +set_shape_body_circle :: + Circle_Body + -> Shape_body +set_shape_body_circle = + HsBindgen.Runtime.Internal.ByteArray.setUnionPayload + +{-| + + __See:__ 'set_shape_body_rectangle' + +__C declaration:__ @rectangle@ + +__defined at:__ @garnet_rs.h 28:20@ + +__exported by:__ @garnet_rs.h@ +-} +get_shape_body_rectangle :: + Shape_body + -> Rectangle_Body +get_shape_body_rectangle = + HsBindgen.Runtime.Internal.ByteArray.getUnionPayload + +{-| + + __See:__ 'get_shape_body_rectangle' + +-} +set_shape_body_rectangle :: + Rectangle_Body + -> Shape_body +set_shape_body_rectangle = + HsBindgen.Runtime.Internal.ByteArray.setUnionPayload + +instance HsBindgen.Runtime.HasCField.HasCField Shape_body "circle" where + + type CFieldType Shape_body "circle" = Circle_Body + + offset# = \_ -> \_ -> 0 + +instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Shape_body) "circle") + ) => GHC.Records.HasField "circle" (Ptr.Ptr Shape_body) (Ptr.Ptr ty) where + + getField = + HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"circle") + +instance HsBindgen.Runtime.HasCField.HasCField Shape_body "rectangle" where + + type CFieldType Shape_body "rectangle" = + Rectangle_Body + + offset# = \_ -> \_ -> 0 + +instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Shape_body) "rectangle") + ) => GHC.Records.HasField "rectangle" (Ptr.Ptr Shape_body) (Ptr.Ptr ty) where + + getField = + HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"rectangle") + +{-| __C declaration:__ @struct Shape@ + + __defined at:__ @garnet_rs.h 24:16@ + + __exported by:__ @garnet_rs.h@ +-} +data Shape = Shape + { tag :: Shape_Tag + {- ^ __C declaration:__ @tag@ + + __defined at:__ @garnet_rs.h 25:13@ + + __exported by:__ @garnet_rs.h@ + -} + , body :: Shape_body + {- ^ __C declaration:__ @body@ + + __defined at:__ @garnet_rs.h 29:5@ + + __exported by:__ @garnet_rs.h@ + -} + } + deriving stock (GHC.Generics.Generic) + +instance HsBindgen.Runtime.Marshal.StaticSize Shape where + + staticSizeOf = \_ -> (24 :: Int) + + staticAlignment = \_ -> (8 :: Int) + +instance HsBindgen.Runtime.Marshal.ReadRaw Shape where + + readRaw = + \ptr0 -> + pure Shape + <*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"tag") ptr0 + <*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"body") ptr0 + +instance HsBindgen.Runtime.Marshal.WriteRaw Shape where + + writeRaw = + \ptr0 -> + \s1 -> + case s1 of + Shape tag2 body3 -> + HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"tag") ptr0 tag2 + >> HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"body") ptr0 body3 + +deriving via HsBindgen.Runtime.Marshal.EquivStorable Shape instance F.Storable Shape + +instance HsBindgen.Runtime.HasCField.HasCField Shape "tag" where + + type CFieldType Shape "tag" = Shape_Tag + + offset# = \_ -> \_ -> 0 + +instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Shape) "tag") + ) => GHC.Records.HasField "tag" (Ptr.Ptr Shape) (Ptr.Ptr ty) where + + getField = + HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"tag") + +instance HsBindgen.Runtime.HasCField.HasCField Shape "body" where + + type CFieldType Shape "body" = Shape_body + + offset# = \_ -> \_ -> 8 + +instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Shape) "body") + ) => GHC.Records.HasField "body" (Ptr.Ptr Shape) (Ptr.Ptr ty) where + + getField = + HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"body") diff --git a/haskell/generated/GarnetRs/FunPtr.hs b/haskell/generated/GarnetRs/FunPtr.hs new file mode 100644 index 0000000..8e6972e --- /dev/null +++ b/haskell/generated/GarnetRs/FunPtr.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_HADDOCK prune #-} + +module GarnetRs.FunPtr where + +import qualified Foreign.C as FC +import qualified GHC.IO.Unsafe +import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.Internal.CAPI +import qualified HsBindgen.Runtime.Internal.HasFFIType +import qualified HsBindgen.Runtime.PtrConst +import Data.Void (Void) +import Prelude (IO) + +$(HsBindgen.Runtime.Internal.CAPI.addCSource (HsBindgen.Runtime.Internal.CAPI.unlines + [ "#include " + , "/* com_garnet_GarnetRs_get_hello */" + , "__attribute__ ((const))" + , "void (*hs_bindgen_faf62265b53521d3 (void)) (" + , " char const *arg1" + , ")" + , "{" + , " return &hello;" + , "}" + ])) + +-- __unique:__ @com_garnet_GarnetRs_get_hello@ +foreign import ccall unsafe "hs_bindgen_faf62265b53521d3" hs_bindgen_faf62265b53521d3_base :: + IO (Ptr.FunPtr Void) + +-- __unique:__ @com_garnet_GarnetRs_get_hello@ +hs_bindgen_faf62265b53521d3 :: IO (Ptr.FunPtr ((HsBindgen.Runtime.PtrConst.PtrConst FC.CChar) -> IO ())) +hs_bindgen_faf62265b53521d3 = + HsBindgen.Runtime.Internal.HasFFIType.fromFFIType hs_bindgen_faf62265b53521d3_base + +{-# NOINLINE hello #-} +{-| __C declaration:__ @hello@ + + __defined at:__ @garnet_rs.h 6:6@ + + __exported by:__ @garnet_rs.h@ +-} +hello :: Ptr.FunPtr ((HsBindgen.Runtime.PtrConst.PtrConst FC.CChar) -> IO ()) +hello = + GHC.IO.Unsafe.unsafePerformIO hs_bindgen_faf62265b53521d3 diff --git a/haskell/generated/GarnetRs/Safe.hs b/haskell/generated/GarnetRs/Safe.hs new file mode 100644 index 0000000..efb2b0e --- /dev/null +++ b/haskell/generated/GarnetRs/Safe.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_HADDOCK prune #-} + +module GarnetRs.Safe where + +import qualified Foreign.C as FC +import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.Internal.CAPI +import qualified HsBindgen.Runtime.Internal.HasFFIType +import qualified HsBindgen.Runtime.PtrConst +import Data.Void (Void) +import Prelude (IO) + +$(HsBindgen.Runtime.Internal.CAPI.addCSource (HsBindgen.Runtime.Internal.CAPI.unlines + [ "#include " + , "void hs_bindgen_433ea2a26af4e593 (" + , " char const *arg1" + , ")" + , "{" + , " hello(arg1);" + , "}" + ])) + +-- __unique:__ @com_garnet_GarnetRs_Safe_hello@ +foreign import ccall safe "hs_bindgen_433ea2a26af4e593" hs_bindgen_433ea2a26af4e593_base :: + Ptr.Ptr Void + -> IO () + +-- __unique:__ @com_garnet_GarnetRs_Safe_hello@ +hs_bindgen_433ea2a26af4e593 :: + HsBindgen.Runtime.PtrConst.PtrConst FC.CChar + -> IO () +hs_bindgen_433ea2a26af4e593 = + HsBindgen.Runtime.Internal.HasFFIType.fromFFIType hs_bindgen_433ea2a26af4e593_base + +{-| __C declaration:__ @hello@ + + __defined at:__ @garnet_rs.h 6:6@ + + __exported by:__ @garnet_rs.h@ +-} +hello :: + HsBindgen.Runtime.PtrConst.PtrConst FC.CChar + -- ^ __C declaration:__ @c@ + -> IO () +hello = hs_bindgen_433ea2a26af4e593 diff --git a/haskell/generated/GarnetRs/Unsafe.hs b/haskell/generated/GarnetRs/Unsafe.hs new file mode 100644 index 0000000..41ba945 --- /dev/null +++ b/haskell/generated/GarnetRs/Unsafe.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_HADDOCK prune #-} + +module GarnetRs.Unsafe where + +import qualified Foreign.C as FC +import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.Internal.CAPI +import qualified HsBindgen.Runtime.Internal.HasFFIType +import qualified HsBindgen.Runtime.PtrConst +import Data.Void (Void) +import Prelude (IO) + +$(HsBindgen.Runtime.Internal.CAPI.addCSource (HsBindgen.Runtime.Internal.CAPI.unlines + [ "#include " + , "void hs_bindgen_2dfe97662a4d6377 (" + , " char const *arg1" + , ")" + , "{" + , " hello(arg1);" + , "}" + ])) + +-- __unique:__ @com_garnet_GarnetRs_Unsafe_hello@ +foreign import ccall unsafe "hs_bindgen_2dfe97662a4d6377" hs_bindgen_2dfe97662a4d6377_base :: + Ptr.Ptr Void + -> IO () + +-- __unique:__ @com_garnet_GarnetRs_Unsafe_hello@ +hs_bindgen_2dfe97662a4d6377 :: + HsBindgen.Runtime.PtrConst.PtrConst FC.CChar + -> IO () +hs_bindgen_2dfe97662a4d6377 = + HsBindgen.Runtime.Internal.HasFFIType.fromFFIType hs_bindgen_2dfe97662a4d6377_base + +{-| __C declaration:__ @hello@ + + __defined at:__ @garnet_rs.h 6:6@ + + __exported by:__ @garnet_rs.h@ +-} +hello :: + HsBindgen.Runtime.PtrConst.PtrConst FC.CChar + -- ^ __C declaration:__ @c@ + -> IO () +hello = hs_bindgen_2dfe97662a4d6377 diff --git a/rust/Cargo.lock b/rust/Cargo.lock index 5c55783..abaa784 100644 --- a/rust/Cargo.lock +++ b/rust/Cargo.lock @@ -2,218 +2,6 @@ # It is not intended for manual editing. version = 4 -[[package]] -name = "antlion" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cd743dc9b5cf465db1be79d28b4bfd7fa143d289546afeea5dc933551883e1f6" -dependencies = [ - "proc-macro2", - "quote", -] - -[[package]] -name = "displaydoc" -version = "0.2.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "97369cbbc041bc366949bc74d34658d6cda5621039731c6310521892a3a20ae0" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.116", -] - [[package]] name = "garnet-rs" version = "0.1.0" -dependencies = [ - "hs-bindgen", -] - -[[package]] -name = "hs-bindgen" -version = "0.8.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3e9723a81f9f23c3e52b01ce72db20c7ab384c8618b1032eea04985260d10fc7" -dependencies = [ - "hs-bindgen-attribute", - "hs-bindgen-traits", -] - -[[package]] -name = "hs-bindgen-attribute" -version = "0.8.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e57fc3cb0491f749fc50e7cf186c189b64af557edb9f78e36eb78bb9021d6624" -dependencies = [ - "antlion", - "displaydoc", - "hs-bindgen-types", - "lazy_static", - "quote", - "rustc_version", - "semver 1.0.27", - "serde", - "syn 1.0.109", - "thiserror", - "toml", -] - -[[package]] -name = "hs-bindgen-traits" -version = "0.8.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e92e839254ee5975299f64183e8346548c4ba5e4ee0253a05426891a6f135a6a" - -[[package]] -name = "hs-bindgen-types" -version = "0.8.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c2d986de5641ea4aa8025589d7243e403961fb0f5572c4dd4764a1bb4a01768c" -dependencies = [ - "displaydoc", - "proc-macro2", - "quote", - "thiserror", -] - -[[package]] -name = "lazy_static" -version = "1.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bbd2bcb4c963f2ddae06a2efc7e9f3591312473c50c6685e1f298068316e66fe" - -[[package]] -name = "proc-macro2" -version = "1.0.106" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8fd00f0bb2e90d81d1044c2b32617f68fcb9fa3bb7640c23e9c748e53fb30934" -dependencies = [ - "unicode-ident", -] - -[[package]] -name = "quote" -version = "1.0.44" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "21b2ebcf727b7760c461f091f9f0f539b77b8e87f2fd88131e7f1b433b3cece4" -dependencies = [ - "proc-macro2", -] - -[[package]] -name = "rustc_version" -version = "0.2.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "138e3e0acb6c9fb258b19b67cb8abd63c00679d2851805ea151465464fe9030a" -dependencies = [ - "semver 0.9.0", -] - -[[package]] -name = "semver" -version = "0.9.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1d7eb9ef2c18661902cc47e535f9bc51b78acd254da71d375c2f6720d9a40403" -dependencies = [ - "semver-parser", -] - -[[package]] -name = "semver" -version = "1.0.27" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d767eb0aabc880b29956c35734170f26ed551a859dbd361d140cdbeca61ab1e2" - -[[package]] -name = "semver-parser" -version = "0.7.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "388a1df253eca08550bef6c72392cfe7c30914bf41df5269b68cbd6ff8f570a3" - -[[package]] -name = "serde" -version = "1.0.228" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9a8e94ea7f378bd32cbbd37198a4a91436180c5bb472411e48b5ec2e2124ae9e" -dependencies = [ - "serde_core", - "serde_derive", -] - -[[package]] -name = "serde_core" -version = "1.0.228" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "41d385c7d4ca58e59fc732af25c3983b67ac852c1a25000afe1175de458b67ad" -dependencies = [ - "serde_derive", -] - -[[package]] -name = "serde_derive" -version = "1.0.228" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d540f220d3187173da220f885ab66608367b6574e925011a9353e4badda91d79" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.116", -] - -[[package]] -name = "syn" -version = "1.0.109" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "72b64191b275b66ffe2469e8af2c1cfe3bafa67b529ead792a6d0160888b4237" -dependencies = [ - "proc-macro2", - "quote", - "unicode-ident", -] - -[[package]] -name = "syn" -version = "2.0.116" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3df424c70518695237746f84cede799c9c58fcb37450d7b23716568cc8bc69cb" -dependencies = [ - "proc-macro2", - "quote", - "unicode-ident", -] - -[[package]] -name = "thiserror" -version = "1.0.69" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b6aaf5339b578ea85b50e080feb250a3e8ae8cfcdff9a461c9ec2904bc923f52" -dependencies = [ - "thiserror-impl", -] - -[[package]] -name = "thiserror-impl" -version = "1.0.69" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4fee6c4efc90059e10f81e6d42c60a18f76588c3d74cb83a0b242a2b6c7504c1" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.116", -] - -[[package]] -name = "toml" -version = "0.5.11" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f4f7f0dd8d50a853a531c426359045b1998f04219d88799810762cd4ad314234" -dependencies = [ - "serde", -] - -[[package]] -name = "unicode-ident" -version = "1.0.24" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e6e4313cd5fcd3dad5cafa179702e2b244f760991f45397d14d4ebf38247da75" diff --git a/rust/Cargo.toml b/rust/Cargo.toml index 5c7c148..42688cf 100644 --- a/rust/Cargo.toml +++ b/rust/Cargo.toml @@ -6,6 +6,3 @@ edition = "2024" [lib] path = "lib.rs" crate-type = ["staticlib"] - -[dependencies] -hs-bindgen = { version = "0.8", features = ["full"] } diff --git a/rust/garnet_rs.h b/rust/garnet_rs.h new file mode 100644 index 0000000..ae756f1 --- /dev/null +++ b/rust/garnet_rs.h @@ -0,0 +1,6 @@ +#include +#include +#include +#include + +void hello(const char *c); diff --git a/rust/hsbindgen.toml b/rust/hsbindgen.toml deleted file mode 100644 index dbd135b..0000000 --- a/rust/hsbindgen.toml +++ /dev/null @@ -1,13 +0,0 @@ -# Since the only `.cabal` format parser implementation and specification live -# in Cabal itself ... this deadly simple config file is used by `hs-bindgen` -# Rust crate to get needed data (like default exposed module name). - -default = "GarnetRs" - -# There is an unlikely future where instead we have a Rust `.cabal` parser, -# that most likely would rely under the hood on a Haskell static lib wrapper -# of `Cabal.Parse` or https://hackage.haskell.org/package/Cabal-syntax library. -# But even in this case, it would be nice to know the `cargo-cabal` version that -# generated the `.cabal` file used. - -version = "0.8.0" \ No newline at end of file diff --git a/rust/lib.rs b/rust/lib.rs index cf17a97..0d4431b 100644 --- a/rust/lib.rs +++ b/rust/lib.rs @@ -1,6 +1,10 @@ -use hs_bindgen::*; +use std::ffi::{CStr, c_char}; -#[hs_bindgen(hello :: CString -> IO (()))] -fn hello(name: &str) { +fn say_hello(name: &str) { println!("Hello from Rust, {name}!"); } + +#[unsafe(no_mangle)] +extern "C" fn hello(c: *const c_char) -> () { + say_hello(unsafe { CStr::from_ptr(c) }.to_str().unwrap()) +}