Skip to content
Permalink
Browse files
Upgrade code and get it all working once again
This fixes year long issues in regards to linking. It's been frustrating
to say the least and was a big reason I let the code bit rot. Given
their is a pandemic goin on now and well I got bored I took the time to
fix all the code. This moves it into Rust 2018 edition works on a newer
version of GHC and overall reformats and cleans up the code with some
better libraries. This isn't the state the release will be in, but it's
just nice to have all the test suites working again and maybe now I can
make some actual progress on creating a good library.
  • Loading branch information
mgattozzi committed Apr 21, 2020
1 parent 6d3ecbc commit 4f44de37f51ffbcd3f5136d0e203cbc9259a8316
Showing 19 changed files with 514 additions and 404 deletions.
@@ -4,7 +4,7 @@ root = true
indent_style = tab

[*.rs]
indent_style = tab
indent_style = space
indent_size = 4

[*.hs]
@@ -2,6 +2,7 @@ target
Cargo.lock
.stack-work
dist
**/dist-newstyle
*.a
*.so
.cabal-sandbox
@@ -1,6 +1,7 @@
[package]
name = "curryrs"
version = "0.2.0"
edition = "2018"
authors = ["Michael Gattozzi <mgattozzi@gmail.com>"]
description = "Utilities making Rust/Haskell FFI easier"
documentation = "https://docs.rs/curryrs/"
@@ -30,6 +31,11 @@ members = ["rtest", "hrgen", "hrgen/hs-type-parser"]
[dependencies]
libc = "0.2"

[build-dependencies]
bindgen = "0.53"
toml = "*"
walkdir = "*"

[features]
# Features available for choosing alternative
# Runtime libraries for Haskell. By default it
@@ -0,0 +1 @@

178 build.rs
@@ -1,22 +1,19 @@
use std::fs::read_dir;
use std::path::Path;
use std::process::Command;
use std::io;
use std::str;
use std::{env, error::Error, path::PathBuf, process::Command, str};
use walkdir::WalkDir;

fn command_output(cmd: &mut Command) -> String {
str::from_utf8(&cmd.output().unwrap().stdout)
.unwrap()
.trim_right()
.to_string()
str::from_utf8(&cmd.output().unwrap().stdout)
.unwrap()
.trim()
.to_string()
}

fn command_ok(cmd: &mut Command) -> bool {
cmd.status().ok().map_or(false, |s| s.success())
cmd.status().ok().map_or(false, |s| s.success())
}

fn ghc(builder: &str, arg: &str) -> String {
command_output(Command::new(builder).args(&["exec", "--", "ghc", arg]))
command_output(Command::new(builder).args(&["exec", "--", "ghc", arg]))
}

// Each os has a diferent extesion for the Dynamic Libraries. This compiles for
@@ -25,78 +22,103 @@ fn ghc(builder: &str, arg: &str) -> String {
const DYLIB_EXTENSION: &'static str = ".so";

#[cfg(target_os = "macos")]
const DYLIB_EXTENSION: &'static str = ".dylib";
const DYLIB_EXTENSION: &'static str = ".a";

#[cfg(target_os = "windows")]
const DYLIB_EXTENSION: &'static str = ".dll";

// This allows the user to choose which version of the Runtime System they want
// to use. By default it is non threaded.
#[cfg(not(any(feature = "threaded", feature = "threaded_l", feature = "threaded_debug")))]
const RTS: &'static str = "libHSrts-g";

#[cfg(feature = "threaded")]
const RTS: &'static str = "libHSrts_thr-";

#[cfg(feature = "threaded_l")]
const RTS: &'static str = "libHSrts_thr_l-";

#[cfg(feature = "threaded_debug")]
const RTS: &'static str = "libHSrts_thr_debug-";

fn main() {
// Traverse the directory to link all of the libs in ghc
// then tell cargo where to get htest for linking
match link_ghc_libs() {
Err(e) => panic!("Unable to link ghc_libs: {}", e),
Ok(_) => println!("cargo:rustc-link-search=native=htest"),
}
// Traverse the directory to link all of the libs in ghc
// then tell cargo where to get htest for linking
match link_ghc_libs() {
Err(e) => panic!("Unable to link ghc_libs: {}", e),
Ok(_) => {
println!("cargo:rustc-link-search=native=htest/dist-newstyle/build/x86_64-osx/ghc-8.8.3/htest-0.1.0.0/build/");
println!("cargo:rustc-link-lib=static=HShtest-0.1.0.0-inplace");

let bindings = bindgen::Builder::default()
// The input header we would like to generate
// bindings for.
.header({
let mut dir = PathBuf::from(ghc("cabal", "--print-libdir"));
dir.push("include");
dir.push("HsFFI.h");
dir.as_os_str().to_owned().to_string_lossy()
})
// Tell cargo to invalidate the built crate whenever any of the
// included header files changed.
.parse_callbacks(Box::new(bindgen::CargoCallbacks))
// Finish the builder and generate the bindings.
.generate()
// Unwrap the Result and panic on failure.
.expect("Unable to generate bindings");
// Write the bindings to the $OUT_DIR/bindings.rs file.
let out_path = PathBuf::from(env::var("OUT_DIR").unwrap());
bindings
.write_to_file(out_path.join("bindings.rs"))
.expect("Couldn't write bindings!");
}
}
}

fn link_ghc_libs() -> io::Result<()> {

let builder = if command_ok(Command::new("stack").arg("--version")) {
"stack"
} else {
"cabal"
};

// Go to the libdir for ghc then traverse all the entries
for entry in try!(read_dir(Path::new(&ghc(builder, "--print-libdir")))) {
let entry = try!(entry);

// For each directory in the libdir check it for .so files and
// link them.
if try!(entry.metadata()).is_dir() {
for item in try!(read_dir(entry.path())) {
match (entry.path().to_str(), try!(item).file_name().to_str()) {
// This directory has lib files link them
(Some(e),Some(i)) => {
if i.starts_with("lib") && i.ends_with(DYLIB_EXTENSION) {

// This filtering of items gets us the bare minimum of libraries
// we need in order to get the Haskell Runtime linked into the
// library. By default it's the non-threaded version that is
// chosen
if i.starts_with(RTS) ||
i.starts_with("libHSghc-") && !i.starts_with("libHSghc-boot-") ||
i.starts_with("libHSbase") ||
i.starts_with("libHSinteger-gmp") {

println!("cargo:rustc-link-search=native={}", e);
// Get rid of lib from the file name
let temp = i.split_at(3).1;
// Get rid of the .so from the file name
let trimmed = temp.split_at(temp.len() - DYLIB_EXTENSION.len()).0;
println!("cargo:rustc-link-lib=dylib={}", trimmed);
}
}
},
_ => panic!("Unable to link ghc libs"),
}
}
}
}

Ok(())
fn link_ghc_libs() -> Result<(), Box<dyn Error>> {
let builder = if command_ok(Command::new("stack").arg("--version")) {
"stack"
} else {
"cabal"
};

// Go to the libdir for ghc then traverse all the entries
for entry in WalkDir::new(&ghc(builder, "--print-libdir"))
.min_depth(1)
.into_iter()
{
let entry = entry?;
match (entry.path().to_str(), entry.file_name().to_str()) {
(Some(e), Some(file_name)) => {
// This filters out every file shipped with GHC that isn't
// a static archive file and only one of every type (RTS and
// C FFI have a few different versions)
if entry.path().extension().map(|y| y != "a").unwrap_or(true)
|| entry.path().is_dir()
|| e.ends_with("_p.a")
|| e.ends_with("_thr.a")
|| e.ends_with("_thr_l.a")
|| e.ends_with("_thr_debug.a")
|| e.ends_with("_l.a")
|| e.ends_with("_debug.a")
|| e.contains("_debug.a")
{
continue;
}

// Get the path without the file in the name
let lib_path = {
let mut path = entry.path().to_owned();
path.pop();
path
}
.to_str()
.unwrap()
.to_owned();

println!("cargo:rustc-link-search=native={}", lib_path);
// Get rid of lib from the file name
let temp = file_name.split_at(3).1;
// Get rid of the .so from the file name
let trimmed = temp.split_at(temp.len() - DYLIB_EXTENSION.len()).0;
println!("cargo:rustc-link-lib=static={}", trimmed);
}
_ => panic!("Unable to link GHC libs at all"),
}
}

// Mac specific linking bugs cause it really is developer hostile and
// doesn't care about you and working!
#[cfg(target_os = "macos")]
println!("cargo:rustc-link-search=native=/usr/lib");
#[cfg(target_os = "macos")]
println!("cargo:rustc-link-lib=dylib=iconv");

Ok(())
}
@@ -32,7 +32,8 @@ test-suite curryrs-test
, tasty-quickcheck >= 0.8.4
-- We only have to do this because ghc-pkg doesn't work with relative paths for
-- extra-lib-dirs.
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Ltarget/release -lrtest -lpthread
ghc-options: -Ltarget/release -lrtest
extra-libraries: pthread
default-language: Haskell2010

benchmark curryrs-bench
@@ -43,7 +44,8 @@ benchmark curryrs-bench
, curryrs
-- We only have to do this because ghc-pkg doesn't work with relative paths for
-- extra-lib-dirs.
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Ltarget/release -lrtest -lpthread
ghc-options: -Ltarget/release -lrtest
extra-libraries: pthread
default-language: Haskell2010

source-repository head
@@ -1,3 +1 @@
fn main() {

}
fn main() {}
@@ -7,19 +7,31 @@ import Test.Tasty.HUnit
import Test.Tasty.QuickCheck

-- Rust Function Imports
foreign import ccall "double_input" doubleInput :: I64 -> I64
foreign import ccall "double_input" doubleInput :: U64 -> U64
foreign import ccall "get_true" getTrue :: Boolean
foreign import ccall "get_false" getFalse :: Boolean

main :: IO ()
main = defaultMain tests

-- Test Function Helpers
divTwo :: I64 -> I64
divTwo x = x `div` 2

timesTwo :: I64 -> I64
timesTwo x = x * 2
divTwo :: Maybe U64 -> Maybe U64
divTwo x = case x of
Just y -> Just $ y `div` 2
Nothing -> Nothing

timesTwo :: U64 -> Maybe U64
timesTwo x
-- This number or higher causes the value to wrap to a negative value
| x >= 4611686018427387904 = Nothing
| otherwise = Just $ x * 2

-- Wrapped Rust code variant
inputDouble :: U64 -> Maybe U64
inputDouble x
-- This number or higher causes the value to wrap to a negative value
| x >= 4611686018427387904 = Nothing
| otherwise = Just $ doubleInput x

-- Test Declarations
tests :: TestTree
@@ -35,8 +47,15 @@ unitTests = testGroup "Unit Tests"
]

quickCheckTests = testGroup "Quickcheck Tests"
[ testProperty "(divTwo . doubleInput) == id" $
\x -> (divTwo . doubleInput) x == id x,
[
testProperty "(divTwo . inputDouble) == id" $
\x -> case (divTwo . inputDouble) x of
Just y -> y == id x
Nothing -> True,

testProperty "doubleInput == timesTwo" $
\x -> doubleInput x == timesTwo x
\x -> case [inputDouble x, timesTwo x] of
[Just x, Just y] -> x == y
[Nothing, Nothing] -> True
otherwise -> False
]

0 comments on commit 4f44de3

Please sign in to comment.