Add a Haskell and a Rust project that talk to each other
This commit is contained in:
parent
8728e0062a
commit
796b67cdb8
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -51,3 +51,5 @@
|
||||
*.out filter=lfs diff=lfs merge=lfs -text
|
||||
*.a filter=lfs diff=lfs merge=lfs -text
|
||||
*.o filter=lfs diff=lfs merge=lfs -text
|
||||
|
||||
Makefile linguist-vendored
|
||||
|
||||
3
.gitignore
vendored
3
.gitignore
vendored
@ -72,6 +72,9 @@ poetry.lock
|
||||
.cargo-ok
|
||||
cobertura.xml
|
||||
tarpaulin-report.html
|
||||
/haskell/dist-newstyle/
|
||||
/haskell/.ghc.environment.*
|
||||
/.cabal/
|
||||
|
||||
# Comment out the next line if you want to checkin your lock file for Cargo
|
||||
Cargo.lock
|
||||
|
||||
@ -1,18 +1,21 @@
|
||||
[package]
|
||||
name = "integrations"
|
||||
version = "0.1.0"
|
||||
edition = "2021"
|
||||
edition = "2024"
|
||||
license = "MIT OR Apache-2.0"
|
||||
publish = false
|
||||
build = "rust/build.rs"
|
||||
|
||||
[lib]
|
||||
path = "rust/lib.rs"
|
||||
crate-type = ["rlib", "staticlib"]
|
||||
|
||||
[[bin]]
|
||||
name = "integrations"
|
||||
path = "rust/main.rs"
|
||||
|
||||
[dependencies]
|
||||
ctor = "0.2"
|
||||
ctor = "0.6.3"
|
||||
libloading = "0.9.0"
|
||||
tracing = "0.1"
|
||||
tracing-subscriber = "0.3"
|
||||
|
||||
14
Makefile
vendored
14
Makefile
vendored
@ -7,7 +7,7 @@ DEBUG_PROJ := 0
|
||||
RUST_BACKTRACE := 1
|
||||
ASSET_DIR := assets
|
||||
TEST_DATA_DIR := tests/testdata
|
||||
SHELL := /bin/bash
|
||||
SHELL := bash
|
||||
|
||||
# Default target
|
||||
.DEFAULT_GOAL := help
|
||||
@ -17,6 +17,18 @@ help: ## Show help messages for all available targets
|
||||
@grep -E '^[a-zA-Z_-]+:.*## .*$$' Makefile | \
|
||||
awk 'BEGIN {FS = ":.*## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}'
|
||||
|
||||
.PHONY: haskell-build
|
||||
haskell-build: ## Build the Haskell interop project and the Rust static library it links against
|
||||
@$(MAKE) -C haskell build
|
||||
|
||||
.PHONY: haskell-run
|
||||
haskell-run: ## Run the Haskell -> Rust demo
|
||||
@$(MAKE) -C haskell run
|
||||
|
||||
.PHONY: rust-calls-haskell
|
||||
rust-calls-haskell: haskell-build ## Run the Rust -> Haskell demo
|
||||
@cargo run -- rust-calls-haskell
|
||||
|
||||
.PHONY: format
|
||||
format: ## Format Rust files
|
||||
@echo "Formatting Rust files..."
|
||||
|
||||
@ -2,7 +2,12 @@
|
||||
|
||||
---
|
||||
|
||||
To be added.
|
||||
Integrating components written in different languages (like Haskell/Rust/C).
|
||||
|
||||
Current demo work lives in `haskell/` and `rust/`.
|
||||
|
||||
- `haskell/` contains a small Cabal project with a Haskell executable that calls into Rust and a foreign library that Rust can call back into.
|
||||
- `rust/` contains the Rust C ABI exports plus a CLI path for Rust calling the Haskell foreign library.
|
||||
|
||||
### License
|
||||
|
||||
|
||||
26
haskell/Makefile
vendored
Normal file
26
haskell/Makefile
vendored
Normal file
@ -0,0 +1,26 @@
|
||||
SHELL := bash
|
||||
CABAL_DIR := $(abspath ../.cabal)
|
||||
CABAL_ENV := CABAL_DIR=$(CABAL_DIR) XDG_STATE_HOME=$(CABAL_DIR)/state XDG_CACHE_HOME=$(CABAL_DIR)/cache XDG_CONFIG_HOME=$(CABAL_DIR)/config
|
||||
|
||||
.DEFAULT_GOAL := help
|
||||
|
||||
.PHONY: help
|
||||
help: ## Show available Haskell interop commands
|
||||
@grep -E '^[a-zA-Z_-]+:.*## .*$$' Makefile | \
|
||||
awk 'BEGIN {FS = ":.*## "}; {printf "\033[36m%-24s\033[0m %s\n", $$1, $$2}'
|
||||
|
||||
.PHONY: rust-lib
|
||||
rust-lib: ## Build the Rust static library used by the Haskell executable
|
||||
@cargo build --manifest-path ../Cargo.toml --lib
|
||||
|
||||
.PHONY: build
|
||||
build: rust-lib ## Build the Haskell project, including the foreign library for Rust
|
||||
@$(CABAL_ENV) cabal build --project-file=cabal.project all
|
||||
|
||||
.PHONY: run
|
||||
run: rust-lib ## Run the Haskell -> Rust demo executable
|
||||
@$(CABAL_ENV) cabal run --project-file=cabal.project haskell-calls-rust -- Ada 7 5
|
||||
|
||||
.PHONY: test
|
||||
test: ## Run the pure Haskell tests
|
||||
@$(CABAL_ENV) cabal test --project-file=cabal.project
|
||||
61
haskell/README.md
Normal file
61
haskell/README.md
Normal file
@ -0,0 +1,61 @@
|
||||
# Haskell Interop Demo
|
||||
|
||||
This directory contains a small Haskell project for the repository's Rust/Haskell integration work.
|
||||
|
||||
The project demonstrates both directions:
|
||||
|
||||
- Haskell calling into Rust through a C ABI exposed by the Rust crate.
|
||||
- Rust calling back into Haskell through a Cabal `foreign-library`, with explicit GHC RTS initialization.
|
||||
|
||||
## Layout
|
||||
|
||||
- `src/Interop/Shared.hs` - pure shared logic plus the C-compatible struct layout used at the boundary.
|
||||
- `src/Interop/Exports.hs` - Haskell functions exported to C for Rust to call.
|
||||
- `app/RustClient.hs` - Haskell imports for the Rust C ABI.
|
||||
- `app/Main.hs` - Haskell executable that demonstrates the Haskell -> Rust path.
|
||||
- `test/Spec.hs` - small pure tests that avoid crossing the FFI boundary.
|
||||
|
||||
The code keeps the FFI surface small on purpose. The boundary uses:
|
||||
|
||||
- integers
|
||||
- a fixed C-shaped struct
|
||||
- owned C strings with an explicit free function on each side
|
||||
|
||||
That is enough to demonstrate the main challenges without pulling in code generation or large bindings.
|
||||
|
||||
## Build And Run
|
||||
|
||||
From the repository root:
|
||||
|
||||
```sh
|
||||
make haskell-build
|
||||
```
|
||||
|
||||
Run the Haskell executable that calls Rust:
|
||||
|
||||
```sh
|
||||
make haskell-run
|
||||
```
|
||||
|
||||
Run the Rust executable that calls the Haskell foreign library:
|
||||
|
||||
```sh
|
||||
make rust-calls-haskell
|
||||
```
|
||||
|
||||
You can also run the commands manually:
|
||||
|
||||
```sh
|
||||
cargo build --lib
|
||||
cabal build --project-file=haskell/cabal.project all
|
||||
cabal run --project-file=haskell/cabal.project haskell-calls-rust -- Ada 7 5
|
||||
cargo run -- rust-calls-haskell Ada 7 5
|
||||
```
|
||||
|
||||
## What This Demonstrates
|
||||
|
||||
- The boundary must stay C-shaped. Rich Rust and Haskell types do not cross directly.
|
||||
- Strings need explicit ownership rules. Each side exports its own free function.
|
||||
- Struct layout must be mirrored carefully on both sides.
|
||||
- Rust calling Haskell is the harder direction because it must initialize and shut down the GHC runtime correctly.
|
||||
- Build order is part of the design. Haskell links against the Rust static library, and Rust loads the Haskell foreign library after Cabal builds it.
|
||||
48
haskell/app/Main.hs
Normal file
48
haskell/app/Main.hs
Normal file
@ -0,0 +1,48 @@
|
||||
module Main (main) where
|
||||
|
||||
import Interop.Shared (Summary (..))
|
||||
import RustClient (callRustMessage, callRustSummary)
|
||||
import System.Environment (getArgs)
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
let (name, left, right) = parseArgs args
|
||||
summary <- callRustSummary left right
|
||||
message <- callRustMessage name left right
|
||||
|
||||
putStrLn "Haskell -> Rust demo"
|
||||
putStrLn $ "Inputs: name=" ++ name ++ ", left=" ++ show left ++ ", right=" ++ show right
|
||||
putStrLn $ "Stats from Rust: " ++ renderSummary summary
|
||||
putStrLn $ "Message from Rust: " ++ message
|
||||
|
||||
parseArgs :: [String] -> (String, Int, Int)
|
||||
parseArgs args =
|
||||
let name = case args of
|
||||
value : _ -> value
|
||||
[] -> "Ada"
|
||||
left = maybe 7 id (pickNumber 1 args)
|
||||
right = maybe 5 id (pickNumber 2 args)
|
||||
in (name, left, right)
|
||||
|
||||
pickNumber :: Int -> [String] -> Maybe Int
|
||||
pickNumber index values = do
|
||||
value <- safeIndex index values
|
||||
readMaybe value
|
||||
|
||||
safeIndex :: Int -> [a] -> Maybe a
|
||||
safeIndex index values
|
||||
| index < 0 = Nothing
|
||||
| otherwise = case drop index values of
|
||||
value : _ -> Just value
|
||||
[] -> Nothing
|
||||
|
||||
renderSummary :: Summary -> String
|
||||
renderSummary summary =
|
||||
"total="
|
||||
++ show (total summary)
|
||||
++ ", product="
|
||||
++ show (combinedProduct summary)
|
||||
++ ", gap="
|
||||
++ show (gap summary)
|
||||
41
haskell/app/RustClient.hs
Normal file
41
haskell/app/RustClient.hs
Normal file
@ -0,0 +1,41 @@
|
||||
module RustClient (
|
||||
callRustMessage,
|
||||
callRustSummary,
|
||||
) where
|
||||
|
||||
import Control.Exception (bracket)
|
||||
import Foreign.C.String (CString, peekCString, withCString)
|
||||
import Foreign.C.Types (CInt (..))
|
||||
import Foreign.Marshal.Alloc (alloca)
|
||||
import Foreign.Ptr (Ptr, nullPtr)
|
||||
import Foreign.Storable (peek)
|
||||
import Interop.Shared (Summary, SharedStats, summaryFromSharedStats)
|
||||
|
||||
foreign import ccall unsafe "rust_compute_stats"
|
||||
rustComputeStats :: CInt -> CInt -> Ptr SharedStats -> IO CInt
|
||||
|
||||
foreign import ccall unsafe "rust_make_message"
|
||||
rustMakeMessage :: CString -> CInt -> CInt -> IO CString
|
||||
|
||||
foreign import ccall unsafe "rust_free_string"
|
||||
rustFreeString :: CString -> IO ()
|
||||
|
||||
callRustSummary :: Int -> Int -> IO Summary
|
||||
callRustSummary left right =
|
||||
alloca $ \outStats -> do
|
||||
status <- rustComputeStats (fromIntegral left) (fromIntegral right) outStats
|
||||
if status /= 0
|
||||
then fail ("rustComputeStats returned status " ++ show status)
|
||||
else summaryFromSharedStats <$> peek outStats
|
||||
|
||||
callRustMessage :: String -> Int -> Int -> IO String
|
||||
callRustMessage name left right =
|
||||
withCString name $ \namePtr -> do
|
||||
messagePtr <- rustMakeMessage namePtr (fromIntegral left) (fromIntegral right)
|
||||
if messagePtr == nullPtr
|
||||
then fail "rustMakeMessage returned a null pointer"
|
||||
else
|
||||
bracket
|
||||
(pure messagePtr)
|
||||
rustFreeString
|
||||
peekCString
|
||||
1
haskell/cabal.project
Normal file
1
haskell/cabal.project
Normal file
@ -0,0 +1 @@
|
||||
packages: .
|
||||
69
haskell/interop-demo.cabal
Normal file
69
haskell/interop-demo.cabal
Normal file
@ -0,0 +1,69 @@
|
||||
cabal-version: 3.8
|
||||
name: haskell-interop-demo
|
||||
version: 0.1.0.0
|
||||
license: MIT
|
||||
build-type: Simple
|
||||
|
||||
common common
|
||||
default-language: GHC2021
|
||||
ghc-options:
|
||||
-Wall
|
||||
-Wcompat
|
||||
-Widentities
|
||||
-Wincomplete-record-updates
|
||||
-Wincomplete-uni-patterns
|
||||
-Wmissing-export-lists
|
||||
-Wmissing-home-modules
|
||||
-Wpartial-fields
|
||||
-Wredundant-constraints
|
||||
build-depends:
|
||||
base >= 4.18 && < 5
|
||||
|
||||
library
|
||||
import: common
|
||||
hs-source-dirs: src
|
||||
exposed-modules:
|
||||
Interop.Exports
|
||||
Interop.Shared
|
||||
|
||||
foreign-library interop_hs
|
||||
import: common
|
||||
type: native-shared
|
||||
options: standalone
|
||||
ghc-options:
|
||||
-dynamic
|
||||
hs-source-dirs: src
|
||||
other-modules:
|
||||
Interop.Exports
|
||||
Interop.Shared
|
||||
|
||||
executable haskell-calls-rust
|
||||
import: common
|
||||
main-is: Main.hs
|
||||
hs-source-dirs:
|
||||
app
|
||||
src
|
||||
other-modules:
|
||||
RustClient
|
||||
Interop.Shared
|
||||
ghc-options:
|
||||
-threaded
|
||||
-rtsopts
|
||||
-with-rtsopts=-N
|
||||
extra-lib-dirs:
|
||||
../target/debug
|
||||
../target/release
|
||||
extra-libraries:
|
||||
integrations
|
||||
|
||||
test-suite haskell-interop-demo-test
|
||||
import: common
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
hs-source-dirs:
|
||||
test
|
||||
src
|
||||
other-modules:
|
||||
Interop.Shared
|
||||
build-depends:
|
||||
haskell-interop-demo
|
||||
38
haskell/src/Interop/Exports.hs
Normal file
38
haskell/src/Interop/Exports.hs
Normal file
@ -0,0 +1,38 @@
|
||||
module Interop.Exports (
|
||||
hsComputeStats,
|
||||
hsFreeString,
|
||||
hsMakeMessage,
|
||||
) where
|
||||
|
||||
import Foreign.C.String (CString, newCString, peekCString)
|
||||
import Foreign.C.Types (CInt (..))
|
||||
import Foreign.Marshal.Alloc (free)
|
||||
import Foreign.Ptr (Ptr, nullPtr)
|
||||
import Foreign.Storable (poke)
|
||||
import Interop.Shared (SharedStats, calculateSummary, formatHaskellMessage, summaryToSharedStats)
|
||||
|
||||
hsComputeStats :: CInt -> CInt -> Ptr SharedStats -> IO CInt
|
||||
hsComputeStats left right outStats
|
||||
| outStats == nullPtr = pure 1
|
||||
| otherwise = do
|
||||
poke outStats $
|
||||
summaryToSharedStats $
|
||||
calculateSummary (fromIntegral left) (fromIntegral right)
|
||||
pure 0
|
||||
|
||||
hsMakeMessage :: CString -> CInt -> CInt -> IO CString
|
||||
hsMakeMessage namePtr left right
|
||||
| namePtr == nullPtr = newCString "Haskell received a null name pointer"
|
||||
| otherwise = do
|
||||
name <- peekCString namePtr
|
||||
let summary = calculateSummary (fromIntegral left) (fromIntegral right)
|
||||
newCString (formatHaskellMessage name summary)
|
||||
|
||||
hsFreeString :: CString -> IO ()
|
||||
hsFreeString ptr
|
||||
| ptr == nullPtr = pure ()
|
||||
| otherwise = free ptr
|
||||
|
||||
foreign export ccall "hs_compute_stats" hsComputeStats :: CInt -> CInt -> Ptr SharedStats -> IO CInt
|
||||
foreign export ccall "hs_make_message" hsMakeMessage :: CString -> CInt -> CInt -> IO CString
|
||||
foreign export ccall "hs_free_string" hsFreeString :: CString -> IO ()
|
||||
82
haskell/src/Interop/Shared.hs
Normal file
82
haskell/src/Interop/Shared.hs
Normal file
@ -0,0 +1,82 @@
|
||||
module Interop.Shared (
|
||||
SharedStats (..),
|
||||
Summary (..),
|
||||
calculateSummary,
|
||||
formatHaskellMessage,
|
||||
summaryFromSharedStats,
|
||||
summaryToSharedStats,
|
||||
) where
|
||||
|
||||
import Foreign.C.Types (CInt)
|
||||
import Foreign.Storable (Storable (..), peekByteOff, pokeByteOff)
|
||||
|
||||
data Summary = Summary
|
||||
{ total :: Int
|
||||
, combinedProduct :: Int
|
||||
, gap :: Int
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
calculateSummary :: Int -> Int -> Summary
|
||||
calculateSummary left right =
|
||||
Summary
|
||||
{ total = left + right
|
||||
, combinedProduct = left * right
|
||||
, gap = abs (left - right)
|
||||
}
|
||||
|
||||
formatHaskellMessage :: String -> Summary -> String
|
||||
formatHaskellMessage name summary =
|
||||
"Haskell handled "
|
||||
++ name
|
||||
++ ": total="
|
||||
++ show (total summary)
|
||||
++ ", product="
|
||||
++ show (combinedProduct summary)
|
||||
++ ", gap="
|
||||
++ show (gap summary)
|
||||
|
||||
data SharedStats = SharedStats
|
||||
{ sharedTotal :: CInt
|
||||
, sharedProduct :: CInt
|
||||
, sharedGap :: CInt
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Storable SharedStats where
|
||||
sizeOf _ = fieldSize * 3
|
||||
where
|
||||
fieldSize = sizeOf (undefined :: CInt)
|
||||
|
||||
alignment _ = alignment (undefined :: CInt)
|
||||
|
||||
peek ptr =
|
||||
SharedStats
|
||||
<$> peekByteOff ptr 0
|
||||
<*> peekByteOff ptr fieldSize
|
||||
<*> peekByteOff ptr (fieldSize * 2)
|
||||
where
|
||||
fieldSize = sizeOf (undefined :: CInt)
|
||||
|
||||
poke ptr value = do
|
||||
pokeByteOff ptr 0 (sharedTotal value)
|
||||
pokeByteOff ptr fieldSize (sharedProduct value)
|
||||
pokeByteOff ptr (fieldSize * 2) (sharedGap value)
|
||||
where
|
||||
fieldSize = sizeOf (undefined :: CInt)
|
||||
|
||||
summaryToSharedStats :: Summary -> SharedStats
|
||||
summaryToSharedStats summary =
|
||||
SharedStats
|
||||
{ sharedTotal = fromIntegral (total summary)
|
||||
, sharedProduct = fromIntegral (combinedProduct summary)
|
||||
, sharedGap = fromIntegral (gap summary)
|
||||
}
|
||||
|
||||
summaryFromSharedStats :: SharedStats -> Summary
|
||||
summaryFromSharedStats stats =
|
||||
Summary
|
||||
{ total = fromIntegral (sharedTotal stats)
|
||||
, combinedProduct = fromIntegral (sharedProduct stats)
|
||||
, gap = fromIntegral (sharedGap stats)
|
||||
}
|
||||
35
haskell/test/Spec.hs
Normal file
35
haskell/test/Spec.hs
Normal file
@ -0,0 +1,35 @@
|
||||
module Main (main) where
|
||||
|
||||
import Interop.Shared (calculateSummary, combinedProduct, formatHaskellMessage, gap, total)
|
||||
import System.Exit (exitFailure)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
assertEqual "summary total" 12 (totalValue 7 5)
|
||||
assertEqual "summary product" 35 (productValue 7 5)
|
||||
assertEqual "summary gap" 2 (gapValue 7 5)
|
||||
assertEqual
|
||||
"message rendering"
|
||||
"Haskell handled Ada: total=12, product=35, gap=2"
|
||||
(formatHaskellMessage "Ada" (calculateSummary 7 5))
|
||||
|
||||
totalValue :: Int -> Int -> Int
|
||||
totalValue left right = total (calculateSummary left right)
|
||||
|
||||
productValue :: Int -> Int -> Int
|
||||
productValue left right = combinedProduct (calculateSummary left right)
|
||||
|
||||
gapValue :: Int -> Int -> Int
|
||||
gapValue left right = gap (calculateSummary left right)
|
||||
|
||||
assertEqual :: (Eq a, Show a) => String -> a -> a -> IO ()
|
||||
assertEqual label expected actual
|
||||
| expected == actual = pure ()
|
||||
| otherwise = do
|
||||
putStrLn $
|
||||
label
|
||||
++ " expected "
|
||||
++ show expected
|
||||
++ " but got "
|
||||
++ show actual
|
||||
exitFailure
|
||||
262
rust/build.rs
Normal file
262
rust/build.rs
Normal file
@ -0,0 +1,262 @@
|
||||
use std::collections::{BTreeSet, HashSet};
|
||||
use std::env;
|
||||
use std::fs;
|
||||
use std::path::{Path, PathBuf};
|
||||
use std::process::Command;
|
||||
|
||||
fn main() {
|
||||
println!("cargo:rerun-if-env-changed=GHC_LIBDIR");
|
||||
println!("cargo:rerun-if-env-changed=GHC_RTS_LIB");
|
||||
println!("cargo:rerun-if-changed=rust/build.rs");
|
||||
|
||||
let libdir = env::var("GHC_LIBDIR").unwrap_or_else(|_| ghc_print_libdir());
|
||||
let explicit_rts = env::var("GHC_RTS_LIB").ok().map(PathBuf::from);
|
||||
let rts_path = explicit_rts.unwrap_or_else(|| find_rts_library(Path::new(&libdir)));
|
||||
let rts_dir = rts_path
|
||||
.parent()
|
||||
.unwrap_or_else(|| Path::new(&libdir))
|
||||
.to_path_buf();
|
||||
let rts_name = rts_path
|
||||
.file_stem()
|
||||
.and_then(|stem| stem.to_str())
|
||||
.map(strip_library_prefix)
|
||||
.unwrap_or_else(|| panic!("failed to resolve GHC RTS library name from {}", rts_path.display()));
|
||||
|
||||
let mut search_dirs = BTreeSet::new();
|
||||
let mut haskell_libs = Vec::new();
|
||||
let mut seen_haskell_libs = HashSet::new();
|
||||
let mut native_libs = BTreeSet::new();
|
||||
|
||||
search_dirs.insert(rts_dir);
|
||||
seen_haskell_libs.insert(rts_name.clone());
|
||||
haskell_libs.push(rts_name);
|
||||
|
||||
for package in ["base", "ghc-prim", "ghc-bignum"] {
|
||||
let info = ghc_pkg_describe(package);
|
||||
for dir in &info.dynamic_library_dirs {
|
||||
search_dirs.insert(dir.clone());
|
||||
}
|
||||
for library in info.hs_libraries {
|
||||
let resolved = resolve_dynamic_hs_library(&library, &info.dynamic_library_dirs);
|
||||
if seen_haskell_libs.insert(resolved.clone()) {
|
||||
haskell_libs.push(resolved);
|
||||
}
|
||||
}
|
||||
|
||||
for library in info.extra_libraries {
|
||||
native_libs.insert(library);
|
||||
}
|
||||
}
|
||||
|
||||
let rts_info = ghc_pkg_describe("rts");
|
||||
for dir in rts_info.dynamic_library_dirs {
|
||||
search_dirs.insert(dir);
|
||||
}
|
||||
for library in rts_info.extra_libraries {
|
||||
native_libs.insert(library);
|
||||
}
|
||||
|
||||
for dir in search_dirs {
|
||||
println!("cargo:rustc-link-search=native={}", dir.display());
|
||||
println!("cargo:rustc-link-arg=-Wl,-rpath,{}", dir.display());
|
||||
}
|
||||
|
||||
println!("cargo:rustc-link-arg=-Wl,--no-as-needed");
|
||||
for library in haskell_libs {
|
||||
println!("cargo:rustc-link-lib=dylib={library}");
|
||||
}
|
||||
println!("cargo:rustc-link-arg=-Wl,--as-needed");
|
||||
|
||||
for library in native_libs {
|
||||
println!("cargo:rustc-link-lib=dylib={library}");
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Default)]
|
||||
struct PackageInfo {
|
||||
hs_libraries: Vec<String>,
|
||||
extra_libraries: Vec<String>,
|
||||
dynamic_library_dirs: Vec<PathBuf>,
|
||||
}
|
||||
|
||||
fn ghc_print_libdir() -> String {
|
||||
let output = Command::new("ghc")
|
||||
.arg("--print-libdir")
|
||||
.output()
|
||||
.unwrap_or_else(|error| panic!("failed to run `ghc --print-libdir`: {error}"));
|
||||
if !output.status.success() {
|
||||
panic!("`ghc --print-libdir` did not exit successfully");
|
||||
}
|
||||
|
||||
String::from_utf8_lossy(&output.stdout).trim().to_string()
|
||||
}
|
||||
|
||||
fn ghc_pkg_describe(package: &str) -> PackageInfo {
|
||||
let output = Command::new("ghc-pkg")
|
||||
.args(["describe", package])
|
||||
.output()
|
||||
.unwrap_or_else(|error| panic!("failed to run `ghc-pkg describe {package}`: {error}"));
|
||||
if !output.status.success() {
|
||||
panic!("`ghc-pkg describe {package}` did not exit successfully");
|
||||
}
|
||||
|
||||
let description = String::from_utf8_lossy(&output.stdout);
|
||||
parse_package_description(&description)
|
||||
}
|
||||
|
||||
fn parse_package_description(description: &str) -> PackageInfo {
|
||||
let mut info = PackageInfo::default();
|
||||
let mut current_field = String::new();
|
||||
let mut pkgroot = String::new();
|
||||
|
||||
for raw_line in description.lines() {
|
||||
let line = raw_line.trim_end();
|
||||
if line.is_empty() {
|
||||
continue;
|
||||
}
|
||||
|
||||
if raw_line.starts_with(' ') || raw_line.starts_with('\t') {
|
||||
push_field_values(¤t_field, line.trim(), &mut pkgroot, &mut info);
|
||||
continue;
|
||||
}
|
||||
|
||||
if let Some((field, rest)) = line.split_once(':') {
|
||||
current_field = field.trim().to_string();
|
||||
push_field_values(¤t_field, rest.trim(), &mut pkgroot, &mut info);
|
||||
}
|
||||
}
|
||||
|
||||
if !pkgroot.is_empty() {
|
||||
for dir in &mut info.dynamic_library_dirs {
|
||||
let resolved = dir
|
||||
.display()
|
||||
.to_string()
|
||||
.replace("${pkgroot}", &pkgroot);
|
||||
*dir = PathBuf::from(resolved);
|
||||
}
|
||||
}
|
||||
|
||||
info
|
||||
}
|
||||
|
||||
fn push_field_values(
|
||||
field: &str,
|
||||
values: &str,
|
||||
pkgroot: &mut String,
|
||||
info: &mut PackageInfo,
|
||||
) {
|
||||
if values.is_empty() {
|
||||
return;
|
||||
}
|
||||
|
||||
match field {
|
||||
"pkgroot" => {
|
||||
*pkgroot = values.trim_matches('"').to_string();
|
||||
}
|
||||
"hs-libraries" => {
|
||||
for value in values.split_whitespace() {
|
||||
info.hs_libraries
|
||||
.push(strip_library_prefix(value.trim_matches('"')));
|
||||
}
|
||||
}
|
||||
"extra-libraries" => {
|
||||
for value in values.split_whitespace() {
|
||||
info.extra_libraries.push(value.trim_matches('"').to_string());
|
||||
}
|
||||
}
|
||||
"dynamic-library-dirs" => {
|
||||
for value in values.split_whitespace() {
|
||||
info.dynamic_library_dirs
|
||||
.push(PathBuf::from(value.trim_matches('"')));
|
||||
}
|
||||
}
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
|
||||
fn resolve_dynamic_hs_library(library: &str, search_dirs: &[PathBuf]) -> String {
|
||||
for dir in search_dirs {
|
||||
let Ok(entries) = fs::read_dir(dir) else {
|
||||
continue;
|
||||
};
|
||||
|
||||
for entry in entries.flatten() {
|
||||
let path = entry.path();
|
||||
let Some(file_name) = path.file_name().and_then(|value| value.to_str()) else {
|
||||
continue;
|
||||
};
|
||||
|
||||
let exact_name = format!("lib{library}.so");
|
||||
let versioned_prefix = format!("lib{library}-");
|
||||
if (file_name == exact_name
|
||||
|| (file_name.starts_with(&versioned_prefix) && file_name.ends_with(".so")))
|
||||
&& path.is_file()
|
||||
{
|
||||
if let Some(stem) = path.file_stem().and_then(|value| value.to_str()) {
|
||||
return strip_library_prefix(stem);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
library.to_string()
|
||||
}
|
||||
|
||||
fn find_rts_library(libdir: &Path) -> PathBuf {
|
||||
let mut candidates = Vec::new();
|
||||
walk_for_rts(libdir, &mut candidates);
|
||||
candidates.sort_by_key(|path| rts_priority(path));
|
||||
|
||||
candidates
|
||||
.into_iter()
|
||||
.next()
|
||||
.unwrap_or_else(|| panic!("failed to locate a GHC RTS library under {}", libdir.display()))
|
||||
}
|
||||
|
||||
fn walk_for_rts(root: &Path, candidates: &mut Vec<PathBuf>) {
|
||||
let Ok(entries) = fs::read_dir(root) else {
|
||||
return;
|
||||
};
|
||||
|
||||
for entry in entries.flatten() {
|
||||
let path = entry.path();
|
||||
if path.is_dir() {
|
||||
walk_for_rts(&path, candidates);
|
||||
continue;
|
||||
}
|
||||
|
||||
if is_threaded_rts_library(&path) {
|
||||
candidates.push(path);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn is_threaded_rts_library(path: &Path) -> bool {
|
||||
let Some(file_name) = path.file_name().and_then(|value| value.to_str()) else {
|
||||
return false;
|
||||
};
|
||||
|
||||
path.extension().and_then(|ext| ext.to_str()) == Some("so") && file_name.starts_with("libHSrts-")
|
||||
}
|
||||
|
||||
fn rts_priority(path: &Path) -> (u8, String) {
|
||||
let file_name = path
|
||||
.file_name()
|
||||
.and_then(|value| value.to_str())
|
||||
.unwrap_or_default()
|
||||
.to_string();
|
||||
|
||||
let rank = if file_name.contains("_debug") {
|
||||
3
|
||||
} else if file_name.contains("_thr") {
|
||||
1
|
||||
} else {
|
||||
0
|
||||
};
|
||||
|
||||
(rank, file_name)
|
||||
}
|
||||
|
||||
fn strip_library_prefix(stem: &str) -> String {
|
||||
stem.strip_prefix("lib").unwrap_or(stem).to_string()
|
||||
}
|
||||
135
rust/cli.rs
135
rust/cli.rs
@ -1,32 +1,137 @@
|
||||
use crate::haskell::{run_haskell_demo, DemoArgs};
|
||||
use std::ffi::OsString;
|
||||
use tracing::error;
|
||||
|
||||
pub fn run(args: impl IntoIterator<Item = OsString>) -> Result<(), i32> {
|
||||
let _args: Vec<OsString> = args.into_iter().collect();
|
||||
if _args.len() < 2 {
|
||||
error!("Expecting at least 2 arguments");
|
||||
return Err(1);
|
||||
let args: Vec<String> = args
|
||||
.into_iter()
|
||||
.map(|arg| arg.to_string_lossy().into_owned())
|
||||
.collect();
|
||||
|
||||
match parse_command(&args) {
|
||||
Ok(Command::Help) => {
|
||||
print_usage(args.first().map(String::as_str).unwrap_or("integrations"));
|
||||
Ok(())
|
||||
}
|
||||
Ok(Command::RustCallsHaskell(demo_args)) => match run_haskell_demo(&demo_args) {
|
||||
Ok(output) => {
|
||||
println!("{output}");
|
||||
Ok(())
|
||||
}
|
||||
Err(message) => {
|
||||
error!("{message}");
|
||||
Err(1)
|
||||
}
|
||||
},
|
||||
Err(message) => {
|
||||
error!("{message}");
|
||||
print_usage(args.first().map(String::as_str).unwrap_or("integrations"));
|
||||
Err(1)
|
||||
}
|
||||
}
|
||||
Ok(())
|
||||
}
|
||||
|
||||
// Unit tests
|
||||
#[derive(Debug, PartialEq, Eq)]
|
||||
enum Command {
|
||||
Help,
|
||||
RustCallsHaskell(DemoArgs),
|
||||
}
|
||||
|
||||
fn parse_command(args: &[String]) -> Result<Command, String> {
|
||||
match args {
|
||||
[_program] => Ok(Command::Help),
|
||||
[_program, command] if command == "help" || command == "--help" || command == "-h" => {
|
||||
Ok(Command::Help)
|
||||
}
|
||||
[_program, command, rest @ ..] if command == "rust-calls-haskell" => {
|
||||
parse_demo_args(rest).map(Command::RustCallsHaskell)
|
||||
}
|
||||
[_program, command, ..] => Err(format!("unknown command: {command}")),
|
||||
[] => Ok(Command::Help),
|
||||
}
|
||||
}
|
||||
|
||||
fn parse_demo_args(args: &[String]) -> Result<DemoArgs, String> {
|
||||
let name = args
|
||||
.first()
|
||||
.cloned()
|
||||
.unwrap_or_else(|| "Ada".to_string());
|
||||
let left = parse_i32_arg(args.get(1), "left operand", 7)?;
|
||||
let right = parse_i32_arg(args.get(2), "right operand", 5)?;
|
||||
let library_path = args.get(3).cloned();
|
||||
|
||||
Ok(DemoArgs {
|
||||
name,
|
||||
left,
|
||||
right,
|
||||
library_path,
|
||||
})
|
||||
}
|
||||
|
||||
fn parse_i32_arg(raw: Option<&String>, label: &str, default: i32) -> Result<i32, String> {
|
||||
match raw {
|
||||
Some(value) => value
|
||||
.parse::<i32>()
|
||||
.map_err(|_| format!("invalid {label}: {value}")),
|
||||
None => Ok(default),
|
||||
}
|
||||
}
|
||||
|
||||
fn print_usage(program: &str) {
|
||||
println!("Usage:");
|
||||
println!(" {program} rust-calls-haskell [name] [left] [right] [haskell-lib-path]");
|
||||
println!();
|
||||
println!("Examples:");
|
||||
println!(" {program} rust-calls-haskell");
|
||||
println!(" {program} rust-calls-haskell Grace 8 3");
|
||||
}
|
||||
|
||||
#[cfg(test)]
|
||||
mod tests {
|
||||
use super::*;
|
||||
use std::ffi::OsString;
|
||||
|
||||
#[test]
|
||||
fn test_run_with_valid_args() {
|
||||
let args = vec![OsString::from("arg1"), OsString::from("arg2")];
|
||||
let result = run(args);
|
||||
assert!(result.is_ok());
|
||||
fn parse_demo_args_uses_defaults() {
|
||||
let args: Vec<String> = Vec::new();
|
||||
let parsed = parse_demo_args(&args).expect("defaults should parse");
|
||||
|
||||
assert_eq!(
|
||||
parsed,
|
||||
DemoArgs {
|
||||
name: "Ada".to_string(),
|
||||
left: 7,
|
||||
right: 5,
|
||||
library_path: None,
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
#[test]
|
||||
fn test_run_with_invalid_args() {
|
||||
let args = vec![OsString::from("invalid_arg")];
|
||||
let result = run(args);
|
||||
assert!(result.is_err());
|
||||
fn parse_demo_args_accepts_explicit_values() {
|
||||
let args = vec![
|
||||
"Linus".to_string(),
|
||||
"9".to_string(),
|
||||
"4".to_string(),
|
||||
"haskell/dist-newstyle/demo/libinterop_hs.so".to_string(),
|
||||
];
|
||||
let parsed = parse_demo_args(&args).expect("explicit args should parse");
|
||||
|
||||
assert_eq!(
|
||||
parsed,
|
||||
DemoArgs {
|
||||
name: "Linus".to_string(),
|
||||
left: 9,
|
||||
right: 4,
|
||||
library_path: Some("haskell/dist-newstyle/demo/libinterop_hs.so".to_string()),
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
#[test]
|
||||
fn parse_command_rejects_unknown_commands() {
|
||||
let args = vec!["integrations".to_string(), "wat".to_string()];
|
||||
let parsed = parse_command(&args);
|
||||
|
||||
assert!(parsed.is_err());
|
||||
}
|
||||
}
|
||||
|
||||
169
rust/haskell.rs
Normal file
169
rust/haskell.rs
Normal file
@ -0,0 +1,169 @@
|
||||
use crate::interop::SharedStats;
|
||||
use libloading::Library;
|
||||
use std::env;
|
||||
use std::ffi::{CStr, CString};
|
||||
use std::fs;
|
||||
use std::os::raw::{c_char, c_int};
|
||||
use std::path::{Path, PathBuf};
|
||||
|
||||
unsafe extern "C" {
|
||||
fn hs_init(argc: *mut c_int, argv: *mut *mut *mut c_char);
|
||||
fn hs_exit();
|
||||
}
|
||||
|
||||
type HsComputeStats = unsafe extern "C" fn(c_int, c_int, *mut SharedStats) -> c_int;
|
||||
type HsMakeMessage = unsafe extern "C" fn(*const c_char, c_int, c_int) -> *mut c_char;
|
||||
type HsFreeString = unsafe extern "C" fn(*mut c_char);
|
||||
|
||||
#[derive(Clone, Debug, PartialEq, Eq)]
|
||||
pub struct DemoArgs {
|
||||
pub name: String,
|
||||
pub left: i32,
|
||||
pub right: i32,
|
||||
pub library_path: Option<String>,
|
||||
}
|
||||
|
||||
pub fn run_haskell_demo(args: &DemoArgs) -> Result<String, String> {
|
||||
let library_path = resolve_library_path(args.library_path.as_deref())?;
|
||||
let runtime = HaskellRuntime::start()?;
|
||||
|
||||
let output = load_and_run(&library_path, args);
|
||||
|
||||
drop(runtime);
|
||||
output
|
||||
}
|
||||
|
||||
struct HaskellRuntime;
|
||||
|
||||
impl HaskellRuntime {
|
||||
fn start() -> Result<Self, String> {
|
||||
let mut argc: c_int = 1;
|
||||
let program_name = CString::new("integrations-hs-runtime")
|
||||
.map_err(|_| "failed to create runtime program name".to_string())?;
|
||||
let mut argv = vec![program_name.as_ptr() as *mut c_char, std::ptr::null_mut()];
|
||||
let mut argv_ptr = argv.as_mut_ptr();
|
||||
|
||||
unsafe {
|
||||
hs_init(&mut argc, &mut argv_ptr);
|
||||
}
|
||||
|
||||
Ok(Self)
|
||||
}
|
||||
}
|
||||
|
||||
impl Drop for HaskellRuntime {
|
||||
fn drop(&mut self) {
|
||||
unsafe {
|
||||
hs_exit();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn load_and_run(library_path: &Path, args: &DemoArgs) -> Result<String, String> {
|
||||
let library = unsafe { Library::new(library_path) }
|
||||
.map_err(|error| format!("failed to load {}: {error}", library_path.display()))?;
|
||||
|
||||
let compute_stats: HsComputeStats = unsafe {
|
||||
*library
|
||||
.get(b"hs_compute_stats\0")
|
||||
.map_err(|error| format!("failed to load hs_compute_stats: {error}"))?
|
||||
};
|
||||
let make_message: HsMakeMessage = unsafe {
|
||||
*library
|
||||
.get(b"hs_make_message\0")
|
||||
.map_err(|error| format!("failed to load hs_make_message: {error}"))?
|
||||
};
|
||||
let free_string: HsFreeString = unsafe {
|
||||
*library
|
||||
.get(b"hs_free_string\0")
|
||||
.map_err(|error| format!("failed to load hs_free_string: {error}"))?
|
||||
};
|
||||
|
||||
let mut stats = SharedStats::default();
|
||||
let status = unsafe { compute_stats(args.left, args.right, &mut stats) };
|
||||
if status != 0 {
|
||||
return Err(format!("hs_compute_stats returned status {status}"));
|
||||
}
|
||||
|
||||
let name = CString::new(args.name.replace('\0', "?"))
|
||||
.map_err(|_| "failed to prepare demo name".to_string())?;
|
||||
let message_ptr = unsafe { make_message(name.as_ptr(), args.left, args.right) };
|
||||
if message_ptr.is_null() {
|
||||
return Err("hs_make_message returned a null pointer".to_string());
|
||||
}
|
||||
|
||||
let message = unsafe { CStr::from_ptr(message_ptr) }
|
||||
.to_string_lossy()
|
||||
.into_owned();
|
||||
unsafe {
|
||||
free_string(message_ptr);
|
||||
}
|
||||
|
||||
Ok(format!(
|
||||
"Rust -> Haskell demo\nLibrary: {}\nInputs: name={}, left={}, right={}\nStats from Haskell: total={}, product={}, gap={}\nMessage from Haskell: {}",
|
||||
library_path.display(),
|
||||
args.name,
|
||||
args.left,
|
||||
args.right,
|
||||
stats.total,
|
||||
stats.product,
|
||||
stats.gap,
|
||||
message,
|
||||
))
|
||||
}
|
||||
|
||||
fn resolve_library_path(explicit_path: Option<&str>) -> Result<PathBuf, String> {
|
||||
if let Some(path) = explicit_path {
|
||||
return Ok(PathBuf::from(path));
|
||||
}
|
||||
|
||||
if let Ok(path) = env::var("HASKELL_FOREIGN_LIB") {
|
||||
return Ok(PathBuf::from(path));
|
||||
}
|
||||
|
||||
let dist_dir = PathBuf::from(env!("CARGO_MANIFEST_DIR"))
|
||||
.join("haskell")
|
||||
.join("dist-newstyle");
|
||||
let mut matches = Vec::new();
|
||||
collect_matching_libraries(&dist_dir, &mut matches)?;
|
||||
matches.sort();
|
||||
|
||||
matches.into_iter().next().ok_or_else(|| {
|
||||
"could not find the Haskell foreign library under haskell/dist-newstyle; run `make haskell-build` first or pass an explicit path".to_string()
|
||||
})
|
||||
}
|
||||
|
||||
fn collect_matching_libraries(root: &Path, matches: &mut Vec<PathBuf>) -> Result<(), String> {
|
||||
if !root.exists() {
|
||||
return Ok(());
|
||||
}
|
||||
|
||||
let entries = fs::read_dir(root)
|
||||
.map_err(|error| format!("failed to read {}: {error}", root.display()))?;
|
||||
for entry in entries {
|
||||
let entry = entry.map_err(|error| format!("failed to inspect {}: {error}", root.display()))?;
|
||||
let path = entry.path();
|
||||
if path.is_dir() {
|
||||
collect_matching_libraries(&path, matches)?;
|
||||
continue;
|
||||
}
|
||||
|
||||
if is_haskell_foreign_library(&path) {
|
||||
matches.push(path);
|
||||
}
|
||||
}
|
||||
|
||||
Ok(())
|
||||
}
|
||||
|
||||
fn is_haskell_foreign_library(path: &Path) -> bool {
|
||||
let Some(file_name) = path.file_name().and_then(|value| value.to_str()) else {
|
||||
return false;
|
||||
};
|
||||
|
||||
let is_library = file_name.ends_with(".so")
|
||||
|| file_name.ends_with(".dylib")
|
||||
|| file_name.ends_with(".dll");
|
||||
|
||||
is_library && file_name.contains("interop_hs")
|
||||
}
|
||||
98
rust/interop.rs
Normal file
98
rust/interop.rs
Normal file
@ -0,0 +1,98 @@
|
||||
use std::ffi::{CStr, CString};
|
||||
use std::os::raw::{c_char, c_int};
|
||||
|
||||
#[repr(C)]
|
||||
#[derive(Clone, Copy, Debug, Default, PartialEq, Eq)]
|
||||
pub struct SharedStats {
|
||||
pub total: c_int,
|
||||
pub product: c_int,
|
||||
pub gap: c_int,
|
||||
}
|
||||
|
||||
pub fn compute_stats(left: c_int, right: c_int) -> SharedStats {
|
||||
SharedStats {
|
||||
total: left.saturating_add(right),
|
||||
product: left.saturating_mul(right),
|
||||
gap: left.saturating_sub(right).abs(),
|
||||
}
|
||||
}
|
||||
|
||||
pub fn make_rust_message(name: &str, left: c_int, right: c_int) -> String {
|
||||
let stats = compute_stats(left, right);
|
||||
format!(
|
||||
"Rust handled {name}: total={}, product={}, gap={}",
|
||||
stats.total, stats.product, stats.gap
|
||||
)
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub unsafe extern "C" fn rust_compute_stats(
|
||||
left: c_int,
|
||||
right: c_int,
|
||||
out_stats: *mut SharedStats,
|
||||
) -> c_int {
|
||||
if out_stats.is_null() {
|
||||
return 1;
|
||||
}
|
||||
|
||||
out_stats.write(compute_stats(left, right));
|
||||
0
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub unsafe extern "C" fn rust_make_message(
|
||||
name: *const c_char,
|
||||
left: c_int,
|
||||
right: c_int,
|
||||
) -> *mut c_char {
|
||||
if name.is_null() {
|
||||
return string_into_raw("Rust received a null name pointer".to_string());
|
||||
}
|
||||
|
||||
let name = CStr::from_ptr(name).to_string_lossy();
|
||||
string_into_raw(make_rust_message(name.as_ref(), left, right))
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub unsafe extern "C" fn rust_free_string(ptr: *mut c_char) {
|
||||
if ptr.is_null() {
|
||||
return;
|
||||
}
|
||||
|
||||
drop(CString::from_raw(ptr));
|
||||
}
|
||||
|
||||
fn string_into_raw(message: String) -> *mut c_char {
|
||||
let sanitized = message.replace('\0', "?");
|
||||
match CString::new(sanitized) {
|
||||
Ok(c_string) => c_string.into_raw(),
|
||||
Err(_) => std::ptr::null_mut(),
|
||||
}
|
||||
}
|
||||
|
||||
#[cfg(test)]
|
||||
mod tests {
|
||||
use super::*;
|
||||
|
||||
#[test]
|
||||
fn compute_stats_matches_expected_values() {
|
||||
assert_eq!(
|
||||
compute_stats(9, 4),
|
||||
SharedStats {
|
||||
total: 13,
|
||||
product: 36,
|
||||
gap: 5,
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
#[test]
|
||||
fn message_contains_name_and_values() {
|
||||
let message = make_rust_message("Ada", 7, 5);
|
||||
|
||||
assert!(message.contains("Ada"));
|
||||
assert!(message.contains("total=12"));
|
||||
assert!(message.contains("product=35"));
|
||||
assert!(message.contains("gap=2"));
|
||||
}
|
||||
}
|
||||
@ -1,2 +1,4 @@
|
||||
pub mod cli;
|
||||
pub mod haskell;
|
||||
pub mod interop;
|
||||
pub mod logging;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user