diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,7 +3,8 @@ [![Build Status](https://travis-ci.org/vmchale/fast-combinatorics.svg?branch=master)](https://travis-ci.org/vmchale/fast-combinatorics) This is a library for fast combinatorics using ATS. As such, make sure -a C compiler is installed, however it may not work on windows. +a C compiler is installed. It may not work on windows, so if you run into bugs +building this please open an issue. Currently it is a work-in-progress, being somewhat constrained by the fact that I have yet to figure out how to share arbitrary-precision types between ATS and Haskell. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -27,7 +27,7 @@ buildScript :: Args -> ConfigFlags -> IO HookedBuildInfo buildScript _ _ = do - needsSetup <- not <$> doesDirectoryExist "ATS2-Postiats-include-0.3.8" + needsSetup <- not <$> doesDirectoryExist "ATS2-Postiats-include-0.3.8/prelude" when needsSetup $ do diff --git a/ats-src/combinatorics-ffi.dats b/ats-src/combinatorics-ffi.dats new file mode 100644 --- /dev/null +++ b/ats-src/combinatorics-ffi.dats @@ -0,0 +1,25 @@ +#define ATS_MAINATSFLAG 1 + +#include "share/atspre_staload.hats" +#include "ats-src/combinatorics.dats" + +extern +fun choose_ats {n : nat}{ m : nat | m <= n } : (int(n), int(m)) -> int = + "mac#" + +extern +fun double_factorial {n : nat} : int(n) -> int = + "mac#" + +extern +fun factorial_ats {n : nat} : int(n) -> int = + "mac#" + +implement choose_ats (n, k) = + choose(n, k) + +implement double_factorial (m) = + dfact(m) + +implement factorial_ats (m) = + fact(m) diff --git a/ats-src/combinatorics.dats b/ats-src/combinatorics.dats new file mode 100644 --- /dev/null +++ b/ats-src/combinatorics.dats @@ -0,0 +1,31 @@ +#define ATS_MAINATSFLAG 1 + +#include "share/atspre_staload.hats" + +staload "libats/libc/SATS/math.sats" + +fnx fact {n : nat} .. (k : int(n)) :<> int = + case+ k of + | 0 => 1 + | k =>> fact(k - 1) * k + +fnx dfact {n : nat} .. (k : int(n)) :<> int = + case+ k of + | 0 => 1 + | 1 => 1 + | k =>> k * dfact(k - 2) + +// TODO make this more versatile? +fn choose {n : nat}{ m : nat | m <= n } (n : int(n), k : int(m)) : int = + let + fun numerator_loop { m : nat | m > 1 } .. (i : int(m)) : int = + case+ i of + | 1 => n + | 2 => (n - 1) * n + | i =>> (n + 1 - i) * numerator_loop(i - 1) + in + case+ k of + | 0 => 1 + | 1 => n + | k =>> numerator_loop(k) / fact(k) + end diff --git a/ats-src/numerics-ffi.dats b/ats-src/numerics-ffi.dats new file mode 100644 --- /dev/null +++ b/ats-src/numerics-ffi.dats @@ -0,0 +1,18 @@ +#define ATS_MAINATSFLAG 1 + +#include "share/atspre_staload.hats" +#include "ats-src/numerics.dats" + +extern +fun is_prime_ats { n : nat | n > 0 } : int(n) -> bool = + "mac#" + +extern +fun exp_ats { n : nat | n > 0 } : (int, int(n)) -> int = + "mac#" + +implement is_prime_ats (n) = + is_prime(n) + +implement exp_ats (a, k) = + exp(a, k) diff --git a/ats-src/numerics.dats b/ats-src/numerics.dats new file mode 100644 --- /dev/null +++ b/ats-src/numerics.dats @@ -0,0 +1,60 @@ +#define ATS_MAINATSFLAG 1 + +#include "share/atspre_staload.hats" + +staload "libats/libc/SATS/math.sats" + +fun exp {n : nat} .. (x : int, n : int(n)) : int = + case+ x of + | 0 => 0 + | x => + begin + if n > 0 then + let + val n2 = half(n) + val i2 = n % 2 + in + if i2 = 0 then + exp(x * x, n2) + else + x * exp(x * x, n2) + end + else + 1 + end + +fun sqrt_bad(k : intGt(0)) : [ m : nat ] int(m) = + let + var pre_bound: int = g0float2int(sqrt_float(g0int2float_int_float(k))) + var bad = fix@ f (n : int) : [ m : nat ] int(m) => case+ n of + | 0 => 0 + | n => 1 + f(n - 1) + var bound: [ m : nat ] int(m) = bad(pre_bound) + in + bound + end + +fun is_prime(k : intGt(0)) : bool = + case+ k of + | 1 => false + | k => + begin + let + fun loop {n : nat}{m : nat} .. (i : int(n), bound : int(m)) :<> bool = + if i < bound then + if k % i = 0 then + false + else + true && loop(i + 1, bound) + else + if i = bound then + if k % i = 0 then + false + else + true + else + true + in + loop(2, sqrt_bad(k)) + end + end diff --git a/cabal.project.local b/cabal.project.local new file mode 100644 --- /dev/null +++ b/cabal.project.local @@ -0,0 +1,8 @@ +constraints: fast-combinatorics +development +optimization: 2 +with-compiler: ghc-8.2.2 +tests: True +benchmarks: True +documentation: True +haddock-hoogle: True +haddock-internal: True diff --git a/cbits/combinatorics-ffi.c b/cbits/combinatorics-ffi.c --- a/cbits/combinatorics-ffi.c +++ b/cbits/combinatorics-ffi.c @@ -1,7 +1,7 @@ /* ** ** The C code is generated by [ATS/Postiats-0-3-8] -** The starting compilation time is: 2017-12-30: 23h:56m +** The starting compilation time is: 2017-12-31: 0h:12m ** */ diff --git a/cbits/numerics-ffi.c b/cbits/numerics-ffi.c --- a/cbits/numerics-ffi.c +++ b/cbits/numerics-ffi.c @@ -1,7 +1,7 @@ /* ** ** The C code is generated by [ATS/Postiats-0-3-8] -** The starting compilation time is: 2017-12-30: 23h:56m +** The starting compilation time is: 2017-12-31: 0h:12m ** */ diff --git a/fast-combinatorics.cabal b/fast-combinatorics.cabal --- a/fast-combinatorics.cabal +++ b/fast-combinatorics.cabal @@ -1,5 +1,5 @@ name: fast-combinatorics -version: 0.1.0.4 +version: 0.1.0.5 synopsis: Fast combinatorics. description: Fast combinatorics code with a high level of safety guaranteed by writing it in ATS. homepage: https://github.com//fast-combinatorics#readme @@ -13,6 +13,9 @@ extra-source-files: cbits/combinatorics-ffi.c , cbits/numerics-ffi.c , ATS2-Postiats-include-0.3.8/ccomp/runtime/pats_ccomp_config.h + , stack.yaml + , ats-src/*.dats + , cabal.project.local extra-doc-files: README.md cabal-version: >= 1.18 diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,5 @@ +--- +resolver: lts-10.0 +extra-deps: + - composition-prelude-0.1.1.4 + - combinatorics-0.1.0