diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Changelog for Jikka +## 2021-08-01: v5.1.0.0 + +- Now Kubaru DP is converted to Morau DP. +- The runtime headers are automatically bundled to generated C++ code. + ## 2021-07-28: v5.0.11.1 Uploaded to Hackage: @@ -157,16 +162,15 @@ } ``` - ## 2021-07-21: v5.0.10.0 -- The generated C++ code is optimized. -- `list.append` is added in the restricted Python. +- The generated C++ code is optimized. +- `list.append` is added in the restricted Python. ## 2021-07-14: v5.0.9.0 -- The generated C++ code becomes more natural. -- The restricted Python allows to write `main` function and uses it to analyze input/output format. +- The generated C++ code becomes more natural. +- The restricted Python allows to write `main` function and uses it to analyze input/output format. Input: @@ -291,14 +295,13 @@ Now our core language is very close to GHC' Core. It's curried and has a system for rewrite-rules. - ## 2021-06-29: v5.0.6.0 Error reporting and error recovery are improved. Input: -``` python +```python def solve(n: int) -> bool: a = n + True # err b = 2 * n @@ -307,7 +310,7 @@ Output: -``` console +```console Type Error (line 2 column 13) (user's mistake?): Jikka.RestrictedPython.Convert.TypeInfer: failed to solve type equations: failed to unify type int and type bool: type int is not type bool 1 |def solve(n: int) -> bool: 2 | a = n + True # err @@ -322,8 +325,7 @@ contributions: -- @Koki-Yamaguchi fixed build on macOS ([#28](https://github.com/kmyk/Jikka/pull/28)) - +- @Koki-Yamaguchi fixed build on macOS ([#28](https://github.com/kmyk/Jikka/pull/28)) ## 2021-06-25: v5.0.5.0 @@ -332,7 +334,7 @@ Input, O(N): -``` python +```python def f(n: int) -> int: a = 0 b = 1 @@ -348,7 +350,7 @@ Output, O(log N): -``` c++ +```c++ #include "jikka/all.hpp" #include #include @@ -403,7 +405,7 @@ Input O(N^2): -``` sml +```sml let given N : [2, 200001) in let given A : N -> 200001 in @@ -415,7 +417,7 @@ The generated function (+ main function written by hands) gets AC: -``` c++ +```c++ vector solve(int64_t N, const vector & A) { vector t1(N + 1); t1[0] = INT64_MIN; @@ -444,7 +446,7 @@ Input O(k n): -``` sml +```sml # vim: set filetype=sml: # Jikka v3 @@ -457,7 +459,7 @@ Output O(k + n): -``` c++ +```c++ int64_t solve(int64_t N, const vector & A) { int64_t K = 100000; int64_t a2 = 0; @@ -474,14 +476,14 @@ ## 2019-07-10: v2 -> 競技プログラミングの問題の形式的な表現を受けとり、それに対する解法を出力するプログラムです。 +> 競技プログラミングの問題の形式的な表現を受けとり、それに対する解法を出力するプログラムです。 `v2` is the second prototype. This version reads a mathematical expression written in ML-like language, and only writes a internal AST. Input: -``` ml +```ml # Jikka v2 # https://atcoder.jp/contests/code-festival-2015-final-open/tasks/codefestival_2015_final_d @@ -498,7 +500,7 @@ output min N \ i. max K1 \ t. f i t ``` -``` console +```console $ dotnet run @@ -542,7 +544,7 @@ ## 2019-07-02: v1 -> 数式を入力すると C++ での実装を出力してくれるすごいやつ +> 数式を入力すると C++ での実装を出力してくれるすごいやつ `v1` is the first prototype. This version reads a mathematical expression written in TeX-like notation, and writes a C++ function. @@ -556,7 +558,7 @@ Output: -``` c++ +```c++ int64_t solve(const vector & A, int64_t N) { int64_t t0 = 0; for (int64_t i = 0; i < N; ++ i) { diff --git a/Jikka.cabal b/Jikka.cabal --- a/Jikka.cabal +++ b/Jikka.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: Jikka -version: 5.0.11.2 +version: 5.1.0.0 synopsis: A transpiler from Python to C++ for competitive programming description: Please see the README on GitHub at category: Compilers/Interpreters @@ -20,16 +20,33 @@ extra-source-files: README.md CHANGELOG.md +data-files: + runtime/include/jikka/convex_hull_trick.hpp + runtime/include/jikka/divmod.hpp + runtime/include/jikka/error.hpp + runtime/include/jikka/matrix.hpp + runtime/include/jikka/modulo.hpp + runtime/include/jikka/modulo_matrix.hpp + runtime/include/jikka/not_modulo.hpp + runtime/include/jikka/range.hpp + runtime/include/jikka/segment_tree.hpp + runtime/include/jikka/slope_trick.hpp source-repository head type: git location: https://github.com/kmyk/Jikka +flag embed-runtime + description: Embed files under runtime/include/ to the compiled binary. + manual: True + default: False + library exposed-modules: Jikka.Common.Alpha Jikka.Common.Combinatorics Jikka.Common.Error + Jikka.Common.FileEmbed Jikka.Common.Format.AutoIndent Jikka.Common.Format.Color Jikka.Common.Format.Error @@ -59,6 +76,7 @@ Jikka.Core.Convert.ConvexHullTrick Jikka.Core.Convert.CumulativeSum Jikka.Core.Convert.Eta + Jikka.Core.Convert.KubaruToMorau Jikka.Core.Convert.MakeScanl Jikka.Core.Convert.MatrixExponentiation Jikka.Core.Convert.PropagateMod @@ -77,6 +95,7 @@ Jikka.Core.Language.BuiltinPatterns Jikka.Core.Language.Expr Jikka.Core.Language.FreeVars + Jikka.Core.Language.LambdaPatterns Jikka.Core.Language.Lint Jikka.Core.Language.RewriteRules Jikka.Core.Language.Runtime @@ -85,6 +104,7 @@ Jikka.Core.Language.Value Jikka.CPlusPlus.Convert Jikka.CPlusPlus.Convert.AddMain + Jikka.CPlusPlus.Convert.BundleRuntime Jikka.CPlusPlus.Convert.FromCore Jikka.CPlusPlus.Convert.MoveSemantics Jikka.CPlusPlus.Convert.OptimizeRange @@ -140,10 +160,14 @@ , base >=4.12 && <5 , containers >=0.6.0 && <0.7 , deepseq >=1.4.4 && <1.5 + , directory >=1.3.3 && <1.4 , mtl >=2.2.2 && <2.3 + , template-haskell >=2.14.0 && <2.17 , text >=1.2.3 && <1.3 , transformers >=0.5.6 && <0.6 , vector >=0.12.3 && <0.13 + if flag(embed-runtime) + cpp-options: -DJIKKA_EMBED_RUNTIME default-language: Haskell2010 executable jikka @@ -160,7 +184,9 @@ , base >=4.12 && <5 , containers >=0.6.0 && <0.7 , deepseq >=1.4.4 && <1.5 + , directory >=1.3.3 && <1.4 , mtl >=2.2.2 && <2.3 + , template-haskell >=2.14.0 && <2.17 , text >=1.2.3 && <1.3 , transformers >=0.5.6 && <0.6 , vector >=0.12.3 && <0.13 @@ -181,8 +207,10 @@ , base >=4.12 && <5 , containers >=0.6.0 && <0.7 , deepseq >=1.4.4 && <1.5 + , directory >=1.3.3 && <1.4 , doctest , mtl >=2.2.2 && <2.3 + , template-haskell >=2.14.0 && <2.17 , text >=1.2.3 && <1.3 , transformers >=0.5.6 && <0.6 , vector >=0.12.3 && <0.13 @@ -249,10 +277,12 @@ , base >=4.12 && <5 , containers >=0.6.0 && <0.7 , deepseq >=1.4.4 && <1.5 + , directory >=1.3.3 && <1.4 , hlint , hspec , mtl >=2.2.2 && <2.3 , ormolu + , template-haskell >=2.14.0 && <2.17 , text >=1.2.3 && <1.3 , transformers >=0.5.6 && <0.6 , vector >=0.12.3 && <0.13 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -12,35 +12,57 @@ Jikka はそのような問題を自動で解きます。 そのような問題をとても制限された Python のサブセット言語のコードの形で入力として受け取り、計算量を落とすような最適化を行い、C++ の実装に変換して出力します。 - ## Usage -``` console -$ stack run convert PYTHON_FILE +```console +$ jikka convert PYTHON_FILE ``` +## How to Install + +### Using prebuilt binaries (recommended) + +Go [Releases page](https://github.com/kmyk/Jikka/releases) and download `jikka-vA.B.C.D-Linux`, `jikka-vA.B.C.D-maxOS` or `jikka-vA.B.C.D-Windows.exe`. + +### Using Stack + [Stack](https://www.haskellstack.org/) is required. If you are using Ubuntu, you can install Stack with `$ sudo apt install haskell-stack`. +```console +$ git clone https://github.com/kmyk/Jikka.git +$ cd Jikka +$ stack install +``` +### Using Cabal + +[Cabal](https://www.haskell.org/cabal/) is required. This is bundled [Haskell Platform](https://www.haskell.org/platform/). If you are using Ubuntu, you can install Stack with `$ sudo apt install haskell-platform`. + +```console +$ cabal update +$ cabal install Jikka +``` + ## Documents for users: -- [docs/language.md](https://github.com/kmyk/Jikka/blob/master/docs/language.md) - - [docs/language.ja.md](https://github.com/kmyk/Jikka/blob/master/docs/language.ja.md) (Japanese translation) -- [examples/](https://github.com/kmyk/Jikka/blob/master/examples) -- [CHANGELOG.md](https://github.com/kmyk/Jikka/blob/master/CHANGELOG.md) -- a blog article [競技プログラミングの問題を自動で解きたい - うさぎ小屋](https://kimiyuki.net/blog/2020/12/09/automated-solvers-of-competitive-programming/) (Japanese) +- [docs/language.md](https://github.com/kmyk/Jikka/blob/master/docs/language.md) + - [docs/language.ja.md](https://github.com/kmyk/Jikka/blob/master/docs/language.ja.md) (Japanese translation) +- [docs/optimization.md](https://github.com/kmyk/Jikka/blob/master/docs/language.md) +- [docs/optimization.ja.md](https://github.com/kmyk/Jikka/blob/master/docs/language.md) (Japanese translation) +- [examples/](https://github.com/kmyk/Jikka/blob/master/examples) +- [CHANGELOG.md](https://github.com/kmyk/Jikka/blob/master/CHANGELOG.md) +- a blog article [競技プログラミングの問題を自動で解きたい - うさぎ小屋](https://kimiyuki.net/blog/2020/12/09/automated-solvers-of-competitive-programming/) (Japanese) for developpers: -- [CONTRIBUTING.md](https://github.com/kmyk/Jikka/blob/master/CONTRIBUTING.md) - - [CONTRIBUTING.ja.md](https://github.com/kmyk/Jikka/blob/master/CONTRIBUTING.ja.md) (Japanese translation) -- [docs/DESIGN.md](https://github.com/kmyk/Jikka/blob/master/docs/DESIGN.md) (Japanese) -- [docs/how-it-works.pdf](https://github.com/kmyk/Jikka/blob/master/docs/how-it-works.pdf) (Japanese) -- [Haddock](https://hackage.haskell.org/package/Jikka) - - [Haddock (master)](https://kmyk.github.io/Jikka/) - +- [CONTRIBUTING.md](https://github.com/kmyk/Jikka/blob/master/CONTRIBUTING.md) + - [CONTRIBUTING.ja.md](https://github.com/kmyk/Jikka/blob/master/CONTRIBUTING.ja.md) (Japanese translation) +- [docs/DESIGN.md](https://github.com/kmyk/Jikka/blob/master/docs/DESIGN.md) (Japanese) +- [docs/how-it-works.pdf](https://github.com/kmyk/Jikka/blob/master/docs/how-it-works.pdf) (Japanese) +- [Haddock](https://hackage.haskell.org/package/Jikka) + - [Haddock (master)](https://kmyk.github.io/Jikka/) ## Examples @@ -48,7 +70,7 @@ Input, O(N): -``` python +```python def f(n: int) -> int: a = 0 b = 1 @@ -64,7 +86,7 @@ Output, O(log N): -``` c++ +```c++ #include "jikka/all.hpp" #include #include @@ -173,7 +195,6 @@ } } ``` - ## License diff --git a/runtime/include/jikka/convex_hull_trick.hpp b/runtime/include/jikka/convex_hull_trick.hpp new file mode 100644 --- /dev/null +++ b/runtime/include/jikka/convex_hull_trick.hpp @@ -0,0 +1,128 @@ +#ifndef JIKKA_CONVEX_HULL_TRICK_HPP +#define JIKKA_CONVEX_HULL_TRICK_HPP +/** + * @file jikka/convex_hull_trick.hpp + * @brief Convex Hull Trick + * @author Kimiyuki Onaka + * @copyright Apache License 2.0 + */ +#include +#include +#include +#include +#include +#include + +namespace jikka { + +namespace details { +/** + * @note y = ax + b + */ +struct line_t { + int64_t a, b; +}; +bool operator<(line_t lhs, line_t rhs) { + return std::make_pair(-lhs.a, lhs.b) < std::make_pair(-rhs.a, rhs.b); +} + +struct rational_t { + int64_t num, den; +}; +bool operator<(rational_t lhs, rational_t rhs) { + if (lhs.num == INT64_MAX or rhs.num == -INT64_MAX) + return false; + if (lhs.num == -INT64_MAX or rhs.num == INT64_MAX) + return true; + return (__int128_t)lhs.num * rhs.den < (__int128_t)rhs.num * lhs.den; +} +} // namespace details + +/* + * @brief Convex Hull Trick (非単調, online) + * @docs data_structure/convex_hull_trick.md + */ +class convex_hull_trick { + typedef details::line_t line_t; + typedef details::rational_t rational_t; + static rational_t make_rational(int64_t num, int64_t den = 1) { + if (den < 0) { + num *= -1; + den *= -1; + } + return {num, den}; // NOTE: no reduction + } + +public: + convex_hull_trick() { + lines.insert({+INT64_MAX, 0}); // sentinels + lines.insert({-INT64_MAX, 0}); + cross.emplace(make_rational(-INT64_MAX), (line_t){-INT64_MAX, 0}); + } + /** + * @note O(log n) + */ + void add_line(int64_t a, int64_t b) { + auto it = lines.insert({a, b}).first; + if (not is_required(*prev(it), {a, b}, *next(it))) { + lines.erase(it); + return; + } + cross.erase(cross_point(*prev(it), *next(it))); + { // remove right lines + auto ju = prev(it); + while (ju != lines.begin() and not is_required(*prev(ju), *ju, {a, b})) + --ju; + cross_erase(ju, prev(it)); + it = lines.erase(++ju, it); + } + { // remove left lines + auto ju = next(it); + while (next(ju) != lines.end() and + not is_required({a, b}, *ju, *next(ju))) + ++ju; + cross_erase(++it, ju); + it = prev(lines.erase(it, ju)); + } + cross.emplace(cross_point(*prev(it), *it), *it); + cross.emplace(cross_point(*it, *next(it)), *next(it)); + assert(not empty()); + } + bool empty() const { return lines.size() <= 2; } + /** + * @note O(log n) + */ + int64_t get_min(int64_t x) const { + assert(not empty()); + line_t f = prev(cross.lower_bound(make_rational(x)))->second; + return f.a * x + f.b; + } + +private: + std::set lines; + std::map cross; + template void cross_erase(Iterator first, Iterator last) { + for (; first != last; ++first) { + cross.erase(cross_point(*first, *next(first))); + } + } + rational_t cross_point(line_t f1, line_t f2) const { + if (f1.a == INT64_MAX) + return make_rational(-INT64_MAX); + if (f2.a == -INT64_MAX) + return make_rational(INT64_MAX); + return make_rational(f1.b - f2.b, f2.a - f1.a); + } + bool is_required(line_t f1, line_t f2, line_t f3) const { + if (f1.a == f2.a and f1.b <= f2.b) + return false; + if (f1.a == INT64_MAX or f3.a == -INT64_MAX) + return true; + return (__int128_t)(f2.a - f1.a) * (f3.b - f2.b) < + (__int128_t)(f2.b - f1.b) * (f3.a - f2.a); + } +}; + +} // namespace jikka + +#endif // JIKKA_CONVEX_HULL_TRICK_HPP diff --git a/runtime/include/jikka/divmod.hpp b/runtime/include/jikka/divmod.hpp new file mode 100644 --- /dev/null +++ b/runtime/include/jikka/divmod.hpp @@ -0,0 +1,36 @@ +#ifndef JIKKA_DIVMOD_HPP +#define JIKKA_DIVMOD_HPP +/** + * @file jikka/divmod.hpp + * @author Kimiyuki Onaka + * @copyright Apache License 2.0 + */ +#include +#include + +namespace jikka { + +inline int64_t floordiv(int64_t n, int64_t d) { + assert(d != 0); + return n / d - ((n ^ d) < 0 && n % d); +} + +inline int64_t floormod(int64_t n, int64_t d) { + assert(d != 0); + n %= d; + return (n < 0 ? n + d : n); +} + +inline int64_t ceildiv(int64_t n, int64_t d) { + assert(d != 0); + return n / d + ((n ^ d) >= 0 && n % d); +} + +inline int64_t ceilmod(int64_t n, int64_t d) { + assert(d != 0); + return n - ceildiv(n, d) * d; +} + +} // namespace jikka + +#endif // JIKKA_DIVMOD_HPP diff --git a/runtime/include/jikka/error.hpp b/runtime/include/jikka/error.hpp new file mode 100644 --- /dev/null +++ b/runtime/include/jikka/error.hpp @@ -0,0 +1,21 @@ +#ifndef JIKKA_ERROR_HPP +#define JIKKA_ERROR_HPP +/** + * @file jikka/error.hpp + * @author Kimiyuki Onaka + * @copyright Apache License 2.0 + */ +#include +#include +#include + +namespace jikka { + +template inline T error(const std::string &message) { + std::cerr << message << std::endl; + assert(false); +} + +} // namespace jikka + +#endif // JIKKA_ERROR_HPP diff --git a/runtime/include/jikka/matrix.hpp b/runtime/include/jikka/matrix.hpp new file mode 100644 --- /dev/null +++ b/runtime/include/jikka/matrix.hpp @@ -0,0 +1,81 @@ +#ifndef JIKKA_MATRIX_HPP +#define JIKKA_MATRIX_HPP +/** + * @file jikka/matrix.hpp + * @author Kimiyuki Onaka + * @copyright Apache License 2.0 + */ +#include + +namespace jikka { + +template +using matrix = std::array, H>; + +namespace mat { + +template +std::array ap(const matrix &a, + const std::array &b) { + std::array c = {}; + for (size_t y = 0; y < H; ++y) { + for (size_t x = 0; x < W; ++x) { + c[y] += a[y][x] * b[x]; + } + } + return c; +} + +template matrix zero() { return {}; } + +template matrix one() { + matrix a = {}; + for (size_t i = 0; i < N; ++i) { + a[i][i] = 1; + } + return a; +} + +template +matrix add(const matrix &a, + const matrix &b) { + matrix c; + for (size_t y = 0; y < H; ++y) { + for (size_t x = 0; x < W; ++x) { + c[y][x] = a[y][x] + b[y][x]; + } + } + return c; +} + +template +matrix mul(const matrix &a, + const matrix &b) { + matrix c = {}; + for (size_t y = 0; y < H; ++y) { + for (size_t z = 0; z < N; ++z) { + for (size_t x = 0; x < W; ++x) { + c[y][x] += a[y][z] * b[z][x]; + } + } + } + return c; +} + +template +matrix pow(matrix x, int64_t k) { + matrix y = one(); + for (; k; k >>= 1) { + if (k & 1) { + y = mul(y, x); + } + x = mul(x, x); + } + return y; +} + +} // namespace mat + +} // namespace jikka + +#endif // JIKKA_MATRIX_HPP diff --git a/runtime/include/jikka/modulo.hpp b/runtime/include/jikka/modulo.hpp new file mode 100644 --- /dev/null +++ b/runtime/include/jikka/modulo.hpp @@ -0,0 +1,107 @@ +#ifndef JIKKA_MODULO_HPP +#define JIKKA_MODULO_HPP +/** + * @file jikka/modulo.hpp + * @author Kimiyuki Onaka + * @copyright Apache License 2.0 + */ +#include "jikka/divmod.hpp" +#include +#include +#include +#include + +namespace jikka { + +namespace mod { + +inline int64_t negate(int64_t a, int64_t MOD) { return floormod(-a, MOD); } + +inline int64_t plus(int64_t a, int64_t b, int64_t MOD) { + return floormod(a + b, MOD); +} + +inline int64_t minus(int64_t a, int64_t b, int64_t MOD) { + return floormod(a - b, MOD); +} + +inline int64_t mult(int64_t a, int64_t b, int64_t MOD) { + return floormod(a * b, MOD); +} + +inline int64_t inv(int64_t value, int64_t MOD) { + assert(0 < value and value < MOD); + int64_t a = value, b = MOD; + int64_t x = 0, y = 1; + for (int64_t u = 1, v = 0; a;) { + int64_t q = b / a; + x -= q * u; + std::swap(x, u); + y -= q * v; + std::swap(y, v); + b -= q * a; + std::swap(b, a); + } + assert(value * x + MOD * y == b and b == 1); + if (x < 0) { + x += MOD; + } + assert(0 <= x and x < MOD); + return x; +} + +inline int64_t pow(int64_t x, int64_t k, int64_t MOD) { + assert(k >= 0); + int64_t y = 1; + for (; k > 0; k >>= 1) { + if (k & 1) { + y = y * x % MOD; + } + x = x * x % MOD; + } + if (y < 0) { + y += MOD; + } + return y; +} + +inline int64_t fact(int64_t n, int64_t MOD) { + assert(0 <= n); + assert(1 <= MOD); + static std::unordered_map> memos; + auto &memo = memos[MOD]; + while (static_cast(memo.size()) <= n) { + if (memo.empty()) { + memo.push_back(1); + } + memo.push_back(memo.size() * memo.back() % MOD); + } + return memo[n]; +} + +inline int64_t choose(int64_t n, int64_t r, int64_t MOD) { + assert(0 <= r and r <= n); + assert(1 <= MOD); + return fact(n, MOD) * inv(fact(r, MOD), MOD) % MOD; +} + +inline int64_t permute(int64_t n, int64_t r, int64_t MOD) { + assert(0 <= r and r <= n); + assert(1 <= MOD); + return fact(n, MOD) * inv(fact(n - r, MOD) * fact(r, MOD) % MOD, MOD) % MOD; +} + +inline int64_t multichoose(int64_t n, int64_t r, int64_t MOD) { + assert(0 <= r and r <= n); + assert(1 <= MOD); + if (n == 0 and r == 0) { + return 1; + } + return choose(n + r - 1, r, MOD); +} + +} // namespace mod + +} // namespace jikka + +#endif // JIKKA_MODULO_HPP diff --git a/runtime/include/jikka/modulo_matrix.hpp b/runtime/include/jikka/modulo_matrix.hpp new file mode 100644 --- /dev/null +++ b/runtime/include/jikka/modulo_matrix.hpp @@ -0,0 +1,96 @@ +#ifndef JIKKA_MODULO_MATRIX_HPP +#define JIKKA_MODULO_MATRIX_HPP +/** + * @file jikka/modulo_matrix.hpp + * @author Kimiyuki Onaka + * @copyright Apache License 2.0 + */ +#include "jikka/divmod.hpp" +#include "jikka/matrix.hpp" +#include + +namespace jikka { + +namespace modmat { + +using jikka::floormod; + +template +std::array floormod(std::array x, int64_t MOD) { + for (size_t i = 0; i < N; ++i) { + x[i] = floormod(x[i], MOD); + } + return x; +} + +template +matrix floormod(matrix a, int64_t MOD) { + for (size_t y = 0; y < H; ++y) { + for (size_t x = 0; x < W; ++x) { + a[y][x] = floormod(a[y][x], MOD); + } + } + return a; +} + +template +std::array ap(const matrix &a, + const std::array &b, int64_t MOD) { + std::array c = {}; + for (size_t y = 0; y < H; ++y) { + for (size_t x = 0; x < W; ++x) { + c[y] += a[y][x] * b[x] % MOD; + } + c[y] = floormod(c[y], MOD); + } + return c; +} + +template +matrix add(const matrix &a, + const matrix &b, int64_t MOD) { + matrix c; + for (size_t y = 0; y < H; ++y) { + for (size_t x = 0; x < W; ++x) { + c[y][x] = floormod(a[y][x] + b[y][x], MOD); + } + } + return c; +} + +template +matrix mul(const matrix &a, + const matrix &b, int64_t MOD) { + matrix c = {}; + for (size_t y = 0; y < H; ++y) { + for (size_t z = 0; z < N; ++z) { + for (size_t x = 0; x < W; ++x) { + c[y][x] += a[y][z] * b[z][x] % MOD; + } + } + } + for (size_t y = 0; y < H; ++y) { + for (size_t x = 0; x < W; ++x) { + c[y][x] = floormod(c[y][x], MOD); + } + } + return c; +} + +template +matrix pow(matrix x, int64_t k, int64_t MOD) { + matrix y = mat::one(); + for (; k; k >>= 1) { + if (k & 1) { + y = mul(y, x, MOD); + } + x = mul(x, x, MOD); + } + return y; +} + +} // namespace modmat + +} // namespace jikka + +#endif // JIKKA_MODULO_MATRIX_HPP diff --git a/runtime/include/jikka/not_modulo.hpp b/runtime/include/jikka/not_modulo.hpp new file mode 100644 --- /dev/null +++ b/runtime/include/jikka/not_modulo.hpp @@ -0,0 +1,67 @@ +#ifndef JIKKA_NOT_MODULO_HPP +#define JIKKA_NOT_MODULO_HPP +/** + * @file jikka/not_modulo.hpp + * @author Kimiyuki Onaka + * @copyright Apache License 2.0 + */ +#include +#include + +namespace jikka { + +namespace notmod { + +inline int64_t pow(int64_t x, int64_t k) { + assert(k >= 0); + int64_t y = 1; + for (; k > 0; k >>= 1) { + if (k & 1) { + y *= x; + } + x *= x; + } + return y; +} + +inline int64_t fact(int64_t n) { + assert(0 <= n); + int64_t ans = 1; + for (int i = 0; i < n; ++i) { + ans *= i + 1; + } + return ans; +} + +inline int64_t choose(int64_t n, int64_t r) { + assert(0 <= r and r <= n); + int64_t ans = 1; + for (int i = 0; i < r; ++i) { + ans *= n - i; + ans /= i + 1; + } + return ans; +} + +inline int64_t permute(int64_t n, int64_t r) { + assert(0 <= r and r <= n); + int64_t ans = 1; + for (int i = 0; i < r; ++i) { + ans *= n - i; + } + return ans; +} + +inline int64_t multichoose(int64_t n, int64_t r) { + assert(0 <= r and r <= n); + if (n == 0 and r == 0) { + return 1; + } + return choose(n + r - 1, r); +} + +} // namespace notmod + +} // namespace jikka + +#endif // JIKKA_NOT_MODULO_HPP diff --git a/runtime/include/jikka/range.hpp b/runtime/include/jikka/range.hpp new file mode 100644 --- /dev/null +++ b/runtime/include/jikka/range.hpp @@ -0,0 +1,25 @@ +#ifndef JIKKA_RANGE_HPP +#define JIKKA_RANGE_HPP +/** + * @file jikka/range.hpp + * @author Kimiyuki Onaka + * @copyright Apache License 2.0 + */ +#include +#include +#include + +namespace jikka { + +inline std::vector range(int64_t n) { + if (n < 0) { + return std::vector(); + } + std::vector xs(n); + std::iota(xs.begin(), xs.end(), 0); + return xs; +} + +} // namespace jikka + +#endif // JIKKA_RANGE_HPP diff --git a/runtime/include/jikka/segment_tree.hpp b/runtime/include/jikka/segment_tree.hpp new file mode 100644 --- /dev/null +++ b/runtime/include/jikka/segment_tree.hpp @@ -0,0 +1,28 @@ +#ifndef JIKKA_SEGMENT_TREE_HPP +#define JIKKA_SEGMENT_TREE_HPP +/** + * @file jikka/base.hpp + * @brief utilities for segment trees of AtCoder Library + * @author Kimiyuki Onaka + * @copyright Apache License 2.0 + */ +#include +#include + +namespace jikka { + +inline int64_t plus_int64_t(int64_t a, int64_t b) { return a + b; } + +inline int64_t min_int64_t(int64_t a, int64_t b) { return std::min(a, b); } + +inline int64_t max_int64_t(int64_t a, int64_t b) { return std::max(a, b); } + +inline int64_t const_zero() { return 0; } + +inline int64_t const_int64_min() { return INT64_MIN; } + +inline int64_t const_int64_max() { return INT64_MAX; } + +} // namespace jikka + +#endif // JIKKA_SEGMENT_TREE_HPP diff --git a/runtime/include/jikka/slope_trick.hpp b/runtime/include/jikka/slope_trick.hpp new file mode 100644 --- /dev/null +++ b/runtime/include/jikka/slope_trick.hpp @@ -0,0 +1,162 @@ +#ifndef JIKKA_SLOPE_TRICK +#define JIKKA_SLOPE_TRICK +/** + * @brief Slope-Trick + * @author ei1333 (original author) + * @author Kimiyuki Onaka (maintainer) + * @copyright The Unlicense + * @see https://maspypy.com/slope-trick-1-%E8%A7%A3%E8%AA%AC%E7%B7%A8 + */ +#include +#include +#include +#include +#include + +namespace jikka { + +template struct slope_trick { + + const T INF = std::numeric_limits::max() / 3; + + T min_f; + std::priority_queue, std::less<>> L; + std::priority_queue, std::greater<>> R; + T add_l, add_r; + +private: + void push_R(const T &a) { R.push(a - add_r); } + + T top_R() const { + if (R.empty()) { + return INF; + } else { + return R.top() + add_r; + } + } + + T pop_R() { + T val = top_R(); + if (not R.empty()) { + R.pop(); + } + return val; + } + + void push_L(const T &a) { L.push(a - add_l); } + + T top_L() const { + if (L.empty()) { + return -INF; + } else { + return L.top() + add_l; + } + } + + T pop_L() { + T val = top_L(); + if (not L.empty()) { + L.pop(); + } + return val; + } + + size_t size() { return L.size() + R.size(); } + +public: + slope_trick() : min_f(0), add_l(0), add_r(0) {} + + struct query_t { + T lx, rx, min_f; + }; + + // return min f(x) + query_t query() const { return (query_t){top_L(), top_R(), min_f}; } + + // f(x) += a + void add_all(const T &a) { min_f += a; } + + // add \_ + // f(x) += max(a - x, 0) + void add_a_minus_x(const T &a) { + min_f += std::max(T(0), a - top_R()); + push_R(a); + push_L(pop_R()); + } + + // add _/ + // f(x) += max(x - a, 0) + void add_x_minus_a(const T &a) { + min_f += std::max(T(0), top_L() - a); + push_L(a); + push_R(pop_L()); + } + + // add \/ + // f(x) += abs(x - a) + void add_abs(const T &a) { + add_a_minus_x(a); + add_x_minus_a(a); + } + + // \/ -> \_ + // f_{new} (x) = min f(y) (y <= x) + void clear_right() { + while (not R.empty()) { + R.pop(); + } + } + + // \/ -> _/ + // f_{new} (x) = min f(y) (y >= x) + void clear_left() { + while (not L.empty()) { + L.pop(); + } + } + + // \/ -> \_/ + // f_{new} (x) = min f(y) (x-b <= y <= x-a) + void shift(const T &a, const T &b) { + assert(a <= b); + add_l += a; + add_r += b; + } + + // \/. -> .\/ + // f_{new} (x) = f(x - a) + void shift(const T &a) { shift(a, a); } + + // L, R を破壊する + T get(const T &x) { + T ret = min_f; + while (not L.empty()) { + ret += std::max(T(0), pop_L() - x); + } + while (not R.empty()) { + ret += std::max(T(0), x - pop_R()); + } + return ret; + } + + void merge(slope_trick &st) { + if (st.size() > size()) { + std::swap(st.L, L); + std::swap(st.R, R); + std::swap(st.add_l, add_l); + std::swap(st.add_r, add_r); + std::swap(st.min_f, min_f); + } + while (not st.R.empty()) { + add_x_minus_a(st.pop_R()); + } + while (not st.L.empty()) { + add_a_minus_x(st.pop_L()); + } + min_f += st.min_f; + } +}; + +} // namespace jikka + +#endif // JIKKA_SLOPE_TRICK diff --git a/src/Jikka/CPlusPlus/Convert/BundleRuntime.hs b/src/Jikka/CPlusPlus/Convert/BundleRuntime.hs new file mode 100644 --- /dev/null +++ b/src/Jikka/CPlusPlus/Convert/BundleRuntime.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module : Jikka.CPlusPlus.Convert.BundleRuntime +-- Description : bundles runtime headers to C++ code. / C++ コードにランタイムヘッダーを埋め込みます。 +-- Copyright : (c) Kimiyuki Onaka, 2020 +-- License : Apache License 2.0 +-- Maintainer : kimiyuki95@gmail.com +-- Stability : experimental +-- Portability : portable +module Jikka.CPlusPlus.Convert.BundleRuntime + ( run, + ) +where + +import Control.Monad.State.Strict +import Data.Char +import qualified Data.Set as S +import qualified Data.Text as T +import Jikka.Common.Error + +#ifdef JIKKA_EMBED_RUNTIME +import Jikka.Common.FileEmbed (embedDir) +#else +import qualified Data.Text.IO as T +import Paths_Jikka +import System.IO.Error +#endif + +-- Pragmas needs type annotations when OverloadedStrings is used. See https://github.com/ndmitchell/hlint/issues/372 +{-# ANN module ("HLint: ignore Unused LANGUAGE pragma" :: String) #-} + +#ifdef JIKKA_EMBED_RUNTIME +embeddedRuntimeFiles :: [(FilePath, T.Text)] +embeddedRuntimeFiles = $(embedDir "runtime/include") +#endif + +{-# ANN readRuntimeFile ("HLint: ignore Redundant return" :: String) #-} +readRuntimeFile :: (MonadIO m, MonadError Error m) => FilePath -> m T.Text +readRuntimeFile path = do + return () -- Without this, Ormolu fails with "The GHC parser (in Haddock mode) failed: parse error on input `='" + +#ifdef JIKKA_EMBED_RUNTIME + case lookup ("runtime/include/" ++ path) embeddedRuntimeFiles of + Just file -> return file + Nothing -> throwInternalError $ "failed to open file. It may need recompile the binary?: " ++ path +#else + resolvedPath <- liftIO $ getDataFileName ("runtime/include/" ++ path) + file <- liftIO $ tryIOError (T.readFile resolvedPath) + case file of + Left err -> throwInternalError $ "faild to open file " ++ path ++ ": " ++ show err + Right file -> return file +#endif + +data PreprocessorState = PreprocessorState + { definedMacros :: S.Set String, + ifdefStack :: [Bool] + } + deriving (Eq, Ord, Show, Read) + +initialPreprocessorState :: PreprocessorState +initialPreprocessorState = + PreprocessorState + { definedMacros = S.empty, + ifdefStack = [True] + } + +throwInternalErrorAt'' :: MonadError Error m => FilePath -> Integer -> String -> m a +throwInternalErrorAt'' path lineno msg = wrapError' (path ++ " (line " ++ show lineno ++ ")") $ throwInternalError msg + +runLine :: (MonadIO m, MonadError Error m, MonadState PreprocessorState m) => FilePath -> Integer -> T.Text -> m [T.Text] +runLine path lineno line + | "#include \"" `T.isPrefixOf` line = case T.splitOn "\"" line of + ["#include ", path', ""] -> do + lines <- runFile (T.unpack path') + return (lines ++ [T.pack ("#line " ++ show (lineno + 1) ++ " \"" ++ path ++ "\"")]) + _ -> throwInternalErrorAt'' path lineno "invalid #include \"...\"" + | otherwise = do + stk <- gets ifdefStack + case stk of + True : _ -> return [line] + False : _ -> return [] + [] -> throwInternalError "there are more #endif than #ifdef and #ifndef" + +runLines :: (MonadIO m, MonadError Error m, MonadState PreprocessorState m) => FilePath -> Integer -> [T.Text] -> m [T.Text] +runLines path lineno lines = concat <$> zipWithM (runLine path) [lineno ..] lines + +runFile :: (MonadIO m, MonadError Error m, MonadState PreprocessorState m) => FilePath -> m [T.Text] +runFile path = do + file <- readRuntimeFile path + let lines = T.lines file + let macro = map (\c -> if isAlphaNum c then toUpper c else '_') path + when (length lines < 3) $ do + throwInternalErrorAt'' path 1 "file has too few lines" + when (T.unpack (head lines) /= "#ifndef " ++ macro) $ do + throwInternalErrorAt'' path 1 $ "the first line must be: #ifndef " ++ macro + when (T.unpack (lines !! 1) /= "#define " ++ macro) $ do + throwInternalErrorAt'' path 2 $ "the second line must be: #define " ++ macro + when (T.unpack (last lines) /= "#endif // " ++ macro) $ do + throwInternalErrorAt'' path (toInteger (length lines - 1)) $ "the last line must be: #ifndef " ++ macro + macros <- gets definedMacros + if macro `S.member` macros + then return [] + else do + modify' (\s -> s {definedMacros = S.insert macro macros}) + (T.pack ("#line 3 \"" ++ path ++ "\"") :) <$> runLines path 3 (drop 2 (init lines)) + +removeConsecutiveLineDirectives :: [T.Text] -> [T.Text] +removeConsecutiveLineDirectives = \case + (l1 : l2 : lines) | "#line" `T.isPrefixOf` l1 && "#line" `T.isPrefixOf` l2 -> removeConsecutiveLineDirectives (l2 : lines) + (line : lines) -> line : removeConsecutiveLineDirectives lines + [] -> [] + +-- | `run` bundles runtime headers to C++ code like . +run :: (MonadIO m, MonadError Error m) => T.Text -> m T.Text +run prog = wrapError' "Jikka.CPlusPlus.Convert.BundleRuntime" $ do + lines <- evalStateT (runLines "main.cpp" 1 (T.lines prog)) initialPreprocessorState + return $ T.unlines (removeConsecutiveLineDirectives lines) diff --git a/src/Jikka/CPlusPlus/Convert/FromCore.hs b/src/Jikka/CPlusPlus/Convert/FromCore.hs --- a/src/Jikka/CPlusPlus/Convert/FromCore.hs +++ b/src/Jikka/CPlusPlus/Convert/FromCore.hs @@ -77,7 +77,9 @@ case stmts of [] -> return e _ -> throwInternalError "now builtin values don't use statements" - X.LitInt n -> return $ Y.Lit (Y.LitInt64 n) + X.LitInt n + | - (2 ^ 63) <= n && n < 2 ^ 63 -> return $ Y.Lit (Y.LitInt64 n) + | otherwise -> throwInternalError $ "integer value is too large for int64_t: " ++ show n X.LitBool p -> return $ Y.Lit (Y.LitBool p) X.LitNil t -> do t <- runType t @@ -151,7 +153,7 @@ X.FloorMod -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::floormod" []) [e1, e2] X.CeilDiv -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::ceildiv" []) [e1, e2] X.CeilMod -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::ceilmod" []) [e1, e2] - X.Pow -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::pow" []) [e1, e2] + X.Pow -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::notmod::pow" []) [e1, e2] -- advanced arithmetical functions X.Abs -> go1 $ \e -> Y.Call (Y.Function "std::abs" []) [e] X.Gcd -> go2 $ \e1 e2 -> Y.Call (Y.Function "std::gcd" []) [e1, e2] @@ -206,25 +208,25 @@ X.BitLeftShift -> go2 $ \e1 e2 -> Y.BinOp Y.BitLeftShift e1 e2 X.BitRightShift -> go2 $ \e1 e2 -> Y.BinOp Y.BitRightShift e1 e2 -- matrix functions - X.MatAp h w -> go2 $ \f x -> Y.Call (Y.Function "jikka::matap" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral w)]) [f, x] - X.MatZero n -> go0 $ Y.Call (Y.Function "jikka::matzero" [Y.TyIntValue (fromIntegral n)]) [] - X.MatOne n -> go0 $ Y.Call (Y.Function "jikka::matone" [Y.TyIntValue (fromIntegral n)]) [] - X.MatAdd h w -> go2 $ \f g -> Y.Call (Y.Function "jikka::matadd" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral w)]) [f, g] - X.MatMul h n w -> go2 $ \f g -> Y.Call (Y.Function "jikka::matmul" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral n), Y.TyIntValue (fromIntegral w)]) [f, g] - X.MatPow n -> go2 $ \f k -> Y.Call (Y.Function "jikka::matpow" [Y.TyIntValue (fromIntegral n)]) [f, k] - X.VecFloorMod n -> go2 $ \x m -> Y.Call (Y.Function "jikka::vecfloormod" [Y.TyIntValue (fromIntegral n)]) [x, m] - X.MatFloorMod h w -> go2 $ \f m -> Y.Call (Y.Function "jikka::matfloormod" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral w)]) [f, m] + X.MatAp h w -> go2 $ \f x -> Y.Call (Y.Function "jikka::mat::ap" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral w)]) [f, x] + X.MatZero n -> go0 $ Y.Call (Y.Function "jikka::mat::zero" [Y.TyIntValue (fromIntegral n)]) [] + X.MatOne n -> go0 $ Y.Call (Y.Function "jikka::mat::one" [Y.TyIntValue (fromIntegral n)]) [] + X.MatAdd h w -> go2 $ \f g -> Y.Call (Y.Function "jikka::mat::add" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral w)]) [f, g] + X.MatMul h n w -> go2 $ \f g -> Y.Call (Y.Function "jikka::mat::mul" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral n), Y.TyIntValue (fromIntegral w)]) [f, g] + X.MatPow n -> go2 $ \f k -> Y.Call (Y.Function "jikka::mat::pow" [Y.TyIntValue (fromIntegral n)]) [f, k] + X.VecFloorMod n -> go2 $ \x m -> Y.Call (Y.Function "jikka::modmat::floormod" [Y.TyIntValue (fromIntegral n)]) [x, m] + X.MatFloorMod h w -> go2 $ \f m -> Y.Call (Y.Function "jikka::modmat::floormod" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral w)]) [f, m] -- modular functions - X.ModNegate -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::modnegate" []) [e1, e2] - X.ModPlus -> go3 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::modplus" []) [e1, e2, e3] - X.ModMinus -> go3 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::modminus" []) [e1, e2, e3] - X.ModMult -> go3 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::modmult" []) [e1, e2, e3] - X.ModInv -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::modinv" []) [e1, e2] - X.ModPow -> go3 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::modpow" []) [e1, e2, e3] - X.ModMatAp h w -> go3 $ \f x m -> Y.Call (Y.Function "jikka::modmatap" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral w)]) [f, x, m] - X.ModMatAdd h w -> go3 $ \f g m -> Y.Call (Y.Function "jikka::modmatadd" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral w)]) [f, g, m] - X.ModMatMul h n w -> go3 $ \f g m -> Y.Call (Y.Function "jikka::modmatmul" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral n), Y.TyIntValue (fromIntegral w)]) [f, g, m] - X.ModMatPow n -> go3 $ \f k m -> Y.Call (Y.Function "jikka::modmatpow" [Y.TyIntValue (fromIntegral n)]) [f, k, m] + X.ModNegate -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::mod::negate" []) [e1, e2] + X.ModPlus -> go3 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::mod::plus" []) [e1, e2, e3] + X.ModMinus -> go3 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::mod::minus" []) [e1, e2, e3] + X.ModMult -> go3 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::mod::mult" []) [e1, e2, e3] + X.ModInv -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::mod::inv" []) [e1, e2] + X.ModPow -> go3 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::mod::pow" []) [e1, e2, e3] + X.ModMatAp h w -> go3 $ \f x m -> Y.Call (Y.Function "jikka::modmat::ap" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral w)]) [f, x, m] + X.ModMatAdd h w -> go3 $ \f g m -> Y.Call (Y.Function "jikka::modmat::add" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral w)]) [f, g, m] + X.ModMatMul h n w -> go3 $ \f g m -> Y.Call (Y.Function "jikka::modmat::mul" [Y.TyIntValue (fromIntegral h), Y.TyIntValue (fromIntegral n), Y.TyIntValue (fromIntegral w)]) [f, g, m] + X.ModMatPow n -> go3 $ \f k m -> Y.Call (Y.Function "jikka::modmat::pow" [Y.TyIntValue (fromIntegral n)]) [f, k, m] -- list functions X.Cons t -> go2' $ \x xs -> do t <- runType t @@ -412,7 +414,7 @@ Y.TyInt64 x xs - [Y.Assign (Y.AssignExpr Y.SimpleAssign (Y.LeftVar y) (Y.callFunction "jikka::modmult" [] [Y.Var y, Y.Var x, m]))] + [Y.Assign (Y.AssignExpr Y.SimpleAssign (Y.LeftVar y) (Y.callFunction "jikka::mod::mult" [] [Y.Var y, Y.Var x, m]))] ], Y.Var y ) @@ -526,10 +528,10 @@ X.Equal _ -> go2 $ \e1 e2 -> Y.BinOp Y.Equal e1 e2 X.NotEqual _ -> go2 $ \e1 e2 -> Y.BinOp Y.NotEqual e1 e2 -- combinational functions - X.Fact -> go1 $ \e -> Y.Call (Y.Function "jikka::fact" []) [e] - X.Choose -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::choose" []) [e1, e2] - X.Permute -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::permute" []) [e1, e2] - X.MultiChoose -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::multichoose" []) [e1, e2] + X.Fact -> go1 $ \e -> Y.Call (Y.Function "jikka::notmod::fact" []) [e] + X.Choose -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::notmod::choose" []) [e1, e2] + X.Permute -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::notmod::permute" []) [e1, e2] + X.MultiChoose -> go2 $ \e1 e2 -> Y.Call (Y.Function "jikka::notmod::multichoose" []) [e1, e2] -- data structures X.ConvexHullTrickInit -> go0 $ Y.Call Y.ConvexHullTrickCtor [] X.ConvexHullTrickGetMin -> go2 $ \cht x -> Y.Call (Y.Method "get_min") [cht, x] diff --git a/src/Jikka/CPlusPlus/Convert/MoveSemantics.hs b/src/Jikka/CPlusPlus/Convert/MoveSemantics.hs --- a/src/Jikka/CPlusPlus/Convert/MoveSemantics.hs +++ b/src/Jikka/CPlusPlus/Convert/MoveSemantics.hs @@ -51,10 +51,21 @@ AssignIncr e -> AssignIncr <$> runLeftExpr e AssignDecr e -> AssignDecr <$> runLeftExpr e -isMovable :: VarName -> [[Statement]] -> Bool -isMovable x cont = - let ReadWriteList rs _ = analyzeStatements (concat cont) - in x `S.notMember` rs +isMovableTo :: VarName -> VarName -> [[Statement]] -> Bool +isMovableTo x y cont + | x `S.notMember` readList' (analyzeStatements (concat cont)) = True + | otherwise = + let go = \case + [] -> False + (Assign (AssignExpr SimpleAssign (LeftVar x') (Var y')) : cont') + | x' == x && y' == y -> + let ReadWriteList _ ws' = analyzeStatements cont' + ReadWriteList rs ws = analyzeStatements (concat (tail cont)) + in y `S.notMember` S.unions [ws', rs, ws] + (stmt : cont) -> + let ReadWriteList rs ws = analyzeStatement stmt + in x `S.notMember` S.unions [rs, ws] && go cont + in go (head cont) runStatement :: MonadState (M.Map VarName VarName) m => Statement -> [[Statement]] -> m [Statement] runStatement stmt cont = case stmt of @@ -88,16 +99,16 @@ DeclareCopy e -> DeclareCopy <$> runExpr e DeclareInitialize es -> DeclareInitialize <$> mapM runExpr es case init of - DeclareCopy (Var x) | x `isMovable` cont -> do + DeclareCopy (Var x) | (x `isMovableTo` y) cont -> do modify' (M.insert y x) return [] DeclareCopy (Call ConvexHullTrickCtor []) -> return [Declare t y DeclareDefault] DeclareCopy (Call ConvexHullTrickCopyAddLine [Var x, a, b]) - | x `isMovable` cont -> do + | (x `isMovableTo` y) cont -> do modify' (M.insert y x) return [callMethod' (Var x) "add_line" [a, b]] DeclareCopy (Call (SegmentTreeCopySetPoint _) [Var x, i, a]) - | x `isMovable` cont -> do + | (x `isMovableTo` y) cont -> do modify' (M.insert y x) return [callMethod' (Var x) "set" [i, a]] _ -> do @@ -111,13 +122,13 @@ AssignExpr SimpleAssign (LeftVar y) (Var x) | x == y -> return [] AssignExpr SimpleAssign (LeftVar y) (Call ConvexHullTrickCopyAddLine [Var x, a, b]) | x == y -> return [callMethod' (Var x) "add_line" [a, b]] - | x `isMovable` cont -> do + | (x `isMovableTo` y) cont -> do modify' (M.insert y x) return [callMethod' (Var x) "add_line" [a, b]] | otherwise -> return [Assign e] AssignExpr SimpleAssign (LeftVar y) (Call (SegmentTreeCopySetPoint _) [Var x, i, a]) | x == y -> return [callMethod' (Var x) "set" [i, a]] - | x `isMovable` cont -> do + | (x `isMovableTo` y) cont -> do modify' (M.insert y x) return [callMethod' (Var x) "set" [i, a]] | otherwise -> return [Assign e] diff --git a/src/Jikka/CPlusPlus/Format.hs b/src/Jikka/CPlusPlus/Format.hs --- a/src/Jikka/CPlusPlus/Format.hs +++ b/src/Jikka/CPlusPlus/Format.hs @@ -194,7 +194,9 @@ formatLiteral :: Literal -> Code formatLiteral = \case LitInt32 n -> show n - LitInt64 n -> show n + LitInt64 n + | - (2 ^ 31) <= n && n < 2 ^ 31 -> show n + | otherwise -> show n ++ "ll" LitBool p -> if p then "true" else "false" LitChar c -> show c LitString s -> show s @@ -336,11 +338,18 @@ additionalHeader = map snd $ filter - (\(key, _) -> key `isInfixOf` unlines body) - [ ("jikka::", "#include \"jikka/base.hpp\""), - ("jikka::convex_hull_trick", "#include \"jikka/convex_hull_trick.hpp\""), - ("atcoder::segtree", "#include \"jikka/segment_tree.hpp\""), - ("atcoder::segtree", "#include ") + (\(keys, _) -> any (`isInfixOf` unlines body) keys) + [ (["jikka::floor", "jikka::ceil"], "#include \"jikka/divmod.hpp\""), + (["jikka::range"], "#include \"jikka/range.hpp\""), + (["jikka::error"], "#include \"jikka/error.hpp\""), + (["jikka::mod::"], "#include \"jikka/modulo.hpp\""), + (["jikka::notmod::"], "#include \"jikka/not_modulo.hpp\""), + (["jikka::matrix", "jikka::mat::"], "#include \"jikka/matrix.hpp\""), + (["jikka::modmat::"], "#include \"jikka/modulo_matrix.hpp\""), + (["jikka::convex_hull_trick"], "#include \"jikka/convex_hull_trick.hpp\""), + (["atcoder::segtree"], "#include \"jikka/segment_tree.hpp\""), + (["atcoder::segtree"], "#include "), + (["jikka::slope_trick"], "#include \"jikka/slope_trick.hpp\"") ] in standardHeaders ++ additionalHeader ++ body diff --git a/src/Jikka/CPlusPlus/Language/VariableAnalysis.hs b/src/Jikka/CPlusPlus/Language/VariableAnalysis.hs --- a/src/Jikka/CPlusPlus/Language/VariableAnalysis.hs +++ b/src/Jikka/CPlusPlus/Language/VariableAnalysis.hs @@ -6,7 +6,7 @@ import Jikka.CPlusPlus.Language.Expr data ReadWriteList = ReadWriteList - { readList :: S.Set VarName, + { readList' :: S.Set VarName, writeList :: S.Set VarName } deriving (Eq, Ord, Show, Read) diff --git a/src/Jikka/Common/FileEmbed.hs b/src/Jikka/Common/FileEmbed.hs new file mode 100644 --- /dev/null +++ b/src/Jikka/Common/FileEmbed.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Jikka.Common.FileEmbed where + +import Control.Monad +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Language.Haskell.TH +import Language.Haskell.TH.Syntax (addDependentFile) +import System.Directory + +listDirectoryRecursive :: FilePath -> IO [FilePath] +listDirectoryRecursive path = do + paths <- map ((path ++ "/") ++) <$> listDirectory path + paths <- forM paths $ \path -> do + isDir <- doesDirectoryExist path + if isDir + then listDirectoryRecursive path + else return [path] + return $ concat paths + +-- | `embedDir` find files recursively and embed their contents, like https://hackage.haskell.org/package/file-embed @file-embed@>'s . +-- +-- == Usage +-- +-- > myDir :: [(FilePath, Data.Text.Text)] +-- > myDir = $(embedDir "dirName") +embedDir :: FilePath -> Q Exp +embedDir path = do + paths <- runIO $ listDirectoryRecursive path + contents <- runIO $ mapM T.readFile paths :: Q [T.Text] + mapM_ addDependentFile paths + [e|zip paths contents :: [(FilePath, T.Text)]|] diff --git a/src/Jikka/Core/Convert.hs b/src/Jikka/Core/Convert.hs --- a/src/Jikka/Core/Convert.hs +++ b/src/Jikka/Core/Convert.hs @@ -29,6 +29,7 @@ import qualified Jikka.Core.Convert.ConvexHullTrick as ConvexHullTrick import qualified Jikka.Core.Convert.CumulativeSum as CumulativeSum import qualified Jikka.Core.Convert.Eta as Eta +import qualified Jikka.Core.Convert.KubaruToMorau as KubaruToMorau import qualified Jikka.Core.Convert.MakeScanl as MakeScanl import qualified Jikka.Core.Convert.MatrixExponentiation as MatrixExponentiation import qualified Jikka.Core.Convert.PropagateMod as PropagateMod @@ -56,6 +57,7 @@ prog <- CloseSum.run prog prog <- CloseAll.run prog prog <- CloseMin.run prog + prog <- KubaruToMorau.run prog prog <- CumulativeSum.run prog prog <- SegmentTree.run prog prog <- BubbleLet.run prog diff --git a/src/Jikka/Core/Convert/CloseMin.hs b/src/Jikka/Core/Convert/CloseMin.hs --- a/src/Jikka/Core/Convert/CloseMin.hs +++ b/src/Jikka/Core/Convert/CloseMin.hs @@ -53,7 +53,7 @@ Lam x _ (Min2' _ e1 e2) -> Just $ Min2' t (Min1' t (Cons' t e0 (Map' t1 t2 (Lam x t e1) xs))) (Min1' t (Cons' t e0 (Map' t1 t2 (Lam x t e2) xs))) Lam x _ (Negate' e) -> Just $ Negate' (Max1' t (Cons' t (Negate' e0) (Map' t1 t2 (Lam x IntTy e) xs))) Lam x _ (Plus' e1 e2) | x `isUnusedVar` e1 -> Just $ Plus' e1 (Min1' t (Cons' t (Minus' e0 e1) (Map' t1 t2 (Lam x IntTy e2) xs))) - Lam x _ (Plus' e1 e2) | x `isUnusedVar` e2 -> Just $ Plus' (Min1' t (Cons' t (Minus' e0 e1) (Map' t1 t2 (Lam x IntTy e1) xs))) e2 + Lam x _ (Plus' e1 e2) | x `isUnusedVar` e2 -> Just $ Plus' (Min1' t (Cons' t (Minus' e0 e2) (Map' t1 t2 (Lam x IntTy e1) xs))) e2 _ -> Nothing _ -> Nothing @@ -80,7 +80,7 @@ Lam x _ (Max2' _ e1 e2) -> Just $ Max2' t (Max1' t (Cons' t e0 (Map' t1 t2 (Lam x t e1) xs))) (Max1' t (Cons' t e0 (Map' t1 t2 (Lam x t e2) xs))) Lam x _ (Negate' e) -> Just $ Negate' (Min1' t (Cons' t (Negate' e0) (Map' t1 t2 (Lam x IntTy e) xs))) Lam x _ (Plus' e1 e2) | x `isUnusedVar` e1 -> Just $ Plus' e1 (Max1' t (Cons' t (Minus' e0 e1) (Map' t1 t2 (Lam x IntTy e2) xs))) - Lam x _ (Plus' e1 e2) | x `isUnusedVar` e2 -> Just $ Plus' (Max1' t (Cons' t (Minus' e0 e1) (Map' t1 t2 (Lam x IntTy e1) xs))) e2 + Lam x _ (Plus' e1 e2) | x `isUnusedVar` e2 -> Just $ Plus' (Max1' t (Cons' t (Minus' e0 e2) (Map' t1 t2 (Lam x IntTy e1) xs))) e2 _ -> Nothing _ -> Nothing diff --git a/src/Jikka/Core/Convert/ConvexHullTrick.hs b/src/Jikka/Core/Convert/ConvexHullTrick.hs --- a/src/Jikka/Core/Convert/ConvexHullTrick.hs +++ b/src/Jikka/Core/Convert/ConvexHullTrick.hs @@ -37,9 +37,6 @@ import Jikka.Core.Language.RewriteRules import Jikka.Core.Language.Util -hoistMaybe :: Applicative m => Maybe a -> MaybeT m a -hoistMaybe = MaybeT . pure - -- | This is something commutative because only one kind of @c@ is allowed. plusPair :: (ArithmeticalExpr, ArithmeticalExpr) -> (ArithmeticalExpr, ArithmeticalExpr) -> Maybe (ArithmeticalExpr, ArithmeticalExpr) plusPair (a1, c1) (a2, _) | isZeroArithmeticalExpr a2 = Just (a1, c1) @@ -112,47 +109,48 @@ _ -> Nothing _ -> Nothing -parseLinearFunctionBody :: MonadAlpha m => VarName -> VarName -> Integer -> Expr -> m (Maybe (Expr, Expr, Expr, Expr, Expr)) +parseLinearFunctionBody :: MonadAlpha m => VarName -> VarName -> Integer -> Expr -> m (Maybe (Expr, Expr, Expr, Expr, Expr, Maybe Expr)) parseLinearFunctionBody f i k = runMaybeT . go where + goMin e j step size = case unNPlusKPattern (parseArithmeticalExpr size) of + Just (i', k') | i' == i && k' == k -> do + (a, b, c, d) <- hoistMaybe $ parseLinearFunctionBody' f i j step + -- raname @j@ to @i@ + a <- lift $ substitute j (Var i) a + c <- lift $ substitute j (Var i) c + return (LitInt' 1, a, b, c, d, (`Minus'` d) <$> e) + _ -> hoistMaybe Nothing + goMax e j step size = do + (sign, a, b, c, d, e) <- goMin e j step size + return (Negate' sign, a, Negate' b, Negate' c, d, Negate' <$> e) go = \case - Min1' _ (Map' _ _ (Lam j _ step) (Range1' size)) -> case unNPlusKPattern (parseArithmeticalExpr size) of - Just (i', k') | i' == i && k' == k -> do - (a, b, c, d) <- hoistMaybe $ parseLinearFunctionBody' f i j step - -- raname @j@ to @i@ - a <- lift $ substitute j (Var i) a - c <- lift $ substitute j (Var i) c - return (LitInt' 1, a, b, c, d) - _ -> hoistMaybe Nothing - Max1' _ (Map' _ _ (Lam j _ step) (Range1' size)) -> case unNPlusKPattern (parseArithmeticalExpr size) of - Just (i', k') | i' == i && k' == k -> do - (a, b, c, d) <- hoistMaybe $ parseLinearFunctionBody' f i j step - -- raname @j@ to @i@ - a <- lift $ substitute j (Var i) a - c <- lift $ substitute j (Var i) c - return (LitInt' (-1), a, Negate' b, Negate' c, d) - _ -> hoistMaybe Nothing + Min1' _ (Map' _ _ (Lam j _ step) (Range1' size)) -> goMin Nothing j step size + Max1' _ (Map' _ _ (Lam j _ step) (Range1' size)) -> goMax Nothing j step size + Min1' _ (Cons' _ e (Map' _ _ (Lam j _ step) (Range1' size))) -> goMin (Just e) j step size + Max1' _ (Cons' _ e (Map' _ _ (Lam j _ step) (Range1' size))) -> goMax (Just e) j step size + Min1' _ (Snoc' _ (Map' _ _ (Lam j _ step) (Range1' size)) e) -> goMin (Just e) j step size + Max1' _ (Snoc' _ (Map' _ _ (Lam j _ step) (Range1' size)) e) -> goMax (Just e) j step size Negate' e -> do - (sign, a, b, c, d) <- go e - return (Negate' sign, a, b, c, Negate' d) + (sign, a, b, c, d, e) <- go e + return (Negate' sign, a, b, c, Negate' d, e) Plus' e1 e2 | isConstantTimeExpr e2 -> do - (sign, a, b, c, d) <- go e1 - return (sign, a, b, c, Plus' d e2) + (sign, a, b, c, d, e) <- go e1 + return (sign, a, b, c, Plus' d e2, e) Plus' e1 e2 | isConstantTimeExpr e1 -> do - (sign, a, b, c, d) <- go e2 - return (sign, a, b, c, Plus' e1 d) + (sign, a, b, c, d, e) <- go e2 + return (sign, a, b, c, Plus' e1 d, e) Minus' e1 e2 | isConstantTimeExpr e2 -> do - (sign, a, b, c, d) <- go e1 - return (sign, a, b, c, Minus' d e2) + (sign, a, b, c, d, e) <- go e1 + return (sign, a, b, c, Minus' d e2, e) Minus' e1 e2 | isConstantTimeExpr e1 -> do - (sign, a, b, c, d) <- go e2 - return (Negate' sign, a, b, c, Minus' e1 d) + (sign, a, b, c, d, e) <- go e2 + return (Negate' sign, a, b, c, Minus' e1 d, e) Mult' e1 e2 | isConstantTimeExpr e2 -> do - (sign, a, b, c, d) <- go e1 - return (Mult' sign e2, a, b, c, Mult' d e2) + (sign, a, b, c, d, e) <- go e1 + return (Mult' sign e2, a, b, c, Mult' d e2, e) Mult' e1 e2 | isConstantTimeExpr e1 -> do - (sign, a, b, c, d) <- go e2 - return (Mult' e1 sign, a, b, c, Mult' e1 d) + (sign, a, b, c, d, e) <- go e2 + return (Mult' e1 sign, a, b, c, Mult' e1 d, e) _ -> hoistMaybe Nothing getLength :: Expr -> Maybe Integer @@ -166,27 +164,57 @@ rule = RewriteRule $ \_ -> \case -- build (fun f -> step(f)) base n Build' IntTy (Lam f _ step) base n -> runMaybeT $ do + let ts = [ConvexHullTrickTy, ListTy IntTy] i <- lift genVarName' k <- hoistMaybe $ getLength base step <- replaceLenF f i k step - -- step(f) = sign(f) * min (map (fun j -> a(f, j) c(f) + b(f, j)) (range (i + k))) + d(f) - (sign, a, c, b, d) <- MaybeT $ parseLinearFunctionBody f i k step - x <- lift genVarName' - y <- lift genVarName' - f' <- lift $ genVarName f - let ts = [ConvexHullTrickTy, ListTy IntTy] - -- base' = (empty, base) - let base' = uncurryApp (Tuple' ts) [ConvexHullTrickInit', base] + -- step(f) = sign() * min (cons e(f, i) (map (fun j -> a(f, j) c(f, i) + b(f, j)) (range (i + k)))) + d(f, i) + (sign, a, c, b, d, e) <- MaybeT $ parseLinearFunctionBody f i k step + -- Update base when k = 0. If user's program has no bugs, it uses min(cons(x, xs)) when k = 0. + (base, n, k, c, d, e) <- case (e, k) of + (Just e, 0) -> do + e0 <- lift $ substitute i (LitInt' 0) e + d0 <- lift $ substitute i (LitInt' 0) d + let base' = Let f (ListTy IntTy) base $ Snoc' IntTy base (Plus' (Mult' sign e0) d0) + c <- lift $ substitute i (Plus' (Var i) (LitInt' 1)) c + d <- lift $ substitute i (Plus' (Var i) (LitInt' 1)) d + e <- lift $ substitute i (Plus' (Var i) (LitInt' 1)) e + return (base', Minus' n (LitInt' 1), k + 1, c, d, Just e) + _ -> return (base, n, k, c, d, e) + -- base' = (cht, base) + base' <- do + x <- lift genVarName' + f' <- lift $ genVarName f + i' <- lift $ genVarName i + a <- lift $ substitute f (Var f') a + b <- lift $ substitute f (Var f') b + a <- lift $ substitute i (Var i') a + b <- lift $ substitute i (Var i') b + -- cht for base[0], ..., base[k - 1] + let cht = Foldl' IntTy ConvexHullTrickTy (Lam2 x ConvexHullTrickTy i' IntTy (ConvexHullTrickInsert' (Var x) a b)) ConvexHullTrickInit' (Range1' (LitInt' k)) + return $ + Let f' (ListTy IntTy) base $ + uncurryApp (Tuple' ts) [cht, Var f'] -- step' = fun (cht, f) i -> - -- let f' = setat f index(i) (min cht f[i + k] + c(i)) + -- let f' = setat f index(i) value(..) -- in let cht' = update cht a(i) b(i) -- in (cht', f') - let step' = - Lam2 x (TupleTy ts) i IntTy $ - Let f (ListTy IntTy) (Proj' ts 1 (Var x)) $ + step' <- do + x <- lift genVarName' + -- value(..) = (min e (min cht f[i + k] + c(i))) + let value = Plus' (Mult' sign (maybe id (\e -> Min2' IntTy e) e (ConvexHullTrickGetMin' (Proj' ts 0 (Var x)) c))) d + y <- lift genVarName' + f' <- lift $ genVarName f + a <- lift $ substitute f (Var f') a + b <- lift $ substitute f (Var f') b + a <- lift $ substitute i (Plus' (Var i) (LitInt' k)) a + b <- lift $ substitute i (Plus' (Var i) (LitInt' k)) b + return $ + Lam2 x (TupleTy ts) i IntTy $ + Let f (ListTy IntTy) (Proj' ts 1 (Var x)) $ + Let f' (ListTy IntTy) (Snoc' IntTy (Var f) value) $ Let y ConvexHullTrickTy (ConvexHullTrickInsert' (Proj' ts 0 (Var x)) a b) $ - Let f' (ListTy IntTy) (Snoc' IntTy (Var f) (Plus' (Mult' sign (ConvexHullTrickGetMin' (Var y) c)) d)) $ - uncurryApp (Tuple' ts) [Var y, Var f'] + uncurryApp (Tuple' ts) [Var y, Var f'] -- proj 1 (foldl step' base' (range (n - 1))) return $ Proj' ts 1 (Foldl' IntTy (TupleTy ts) step' base' (Range1' n)) _ -> return Nothing diff --git a/src/Jikka/Core/Convert/KubaruToMorau.hs b/src/Jikka/Core/Convert/KubaruToMorau.hs new file mode 100644 --- /dev/null +++ b/src/Jikka/Core/Convert/KubaruToMorau.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} + +-- | +-- Module : Jikka.Core.Convert.KubaruToMorau +-- Description : converts Kubaru DP to Morau DP. / 配る DP を貰う DP に変換します。 +-- Copyright : (c) Kimiyuki Onaka, 2021 +-- License : Apache License 2.0 +-- Maintainer : kimiyuki95@gmail.com +-- Stability : experimental +-- Portability : portable +module Jikka.Core.Convert.KubaruToMorau + ( run, + + -- * internal rules + rule, + runFunctionBody, + ) +where + +import Control.Monad.Trans.Maybe +import Jikka.Common.Alpha +import Jikka.Common.Error +import Jikka.Core.Language.ArithmeticalExpr +import Jikka.Core.Language.Beta +import Jikka.Core.Language.BuiltinPatterns +import Jikka.Core.Language.Expr +import Jikka.Core.Language.FreeVars +import Jikka.Core.Language.Lint +import Jikka.Core.Language.RewriteRules +import Jikka.Core.Language.Util + +-- | @runFunctionBody c i j step y x k@ returns @step'(y, x, i, k)@ s.t. @step(c, i, j) = step'(c[i + j + 1], c[i], i, i + j + 1)@ +runFunctionBody :: (MonadAlpha m, MonadError Error m) => VarName -> VarName -> VarName -> Expr -> VarName -> VarName -> VarName -> MaybeT m Expr +runFunctionBody c i j step y x k = do + step <- lift $ substitute j (Minus' (Minus' (Var k) (Var i)) (LitInt' 1)) step + let go = \case + Var x + | x == c -> hoistMaybe Nothing + | otherwise -> return $ Var x + Lit lit -> return $ Lit lit + At' _ (Var c') index | c' == c -> case () of + () | parseArithmeticalExpr index == parseArithmeticalExpr (Var i) -> return $ Var x + () | parseArithmeticalExpr index == parseArithmeticalExpr (Var k) -> return $ Var y + () | otherwise -> hoistMaybe Nothing + App e1 e2 -> App <$> go e1 <*> go e2 + Let x t e1 e2 + | x == c || x == i || x == j -> throwRuntimeError "name confliction found" + | otherwise -> Let x t <$> go e1 <*> go e2 + Lam x t e + | x == c || x == i || x == j -> throwRuntimeError "name confliction found" + | otherwise -> Lam x t <$> go e + go step + +-- | TODO: remove the assumption that the length of @a@ is equals to @n@ +rule :: (MonadAlpha m, MonadError Error m) => RewriteRule m +rule = RewriteRule $ \_ -> \case + -- foldl (fun b i -> foldl (fun c j -> setAt c index(i, j) step(c, i, j)) b (range m(i))) a (range n) + Foldl' IntTy (ListTy t2) (Lam2 b _ i _ (Foldl' IntTy (ListTy t2') (Lam2 c _ j _ (SetAt' _ (Var c') index step)) (Var b') (Range1' m))) a (Range1' n) + | t2' == t2 && b' == b && c == c' && b `isUnusedVar` m && b `isUnusedVar` index && b `isUnusedVar` step && c `isUnusedVar` index -> runMaybeT $ do + -- m(i) = n - i - 1 + guard $ parseArithmeticalExpr m == parseArithmeticalExpr (Minus' (Minus' n (Var i)) (LitInt' 1)) + -- index(i, j) = i + j + 1 + guard $ parseArithmeticalExpr index == parseArithmeticalExpr (Plus' (Var i) (Plus' (Var j) (LitInt' 1))) + x <- lift genVarName' + y <- lift genVarName' + k <- lift genVarName' + -- get step'(y, x, i, k) s.t. step(c, i, j) = step'(c[i + j + 1], c[i], i, i + j + 1) + step <- runFunctionBody c i j step y x k + step <- lift $ substitute x (At' t2 (Var c) (Var i)) step + step <- lift $ substitute k (Len' t2 (Var c)) step + let base = At' t2 a (Len' t2 (Var c)) + return $ Build' t2 (Lam c (ListTy t2) (Foldl' IntTy t2 (Lam2 y t2 i IntTy step) base (Range1' (Len' t2 (Var c))))) (Nil' t2) n + _ -> return Nothing + +runProgram :: (MonadAlpha m, MonadError Error m) => Program -> m Program +runProgram = applyRewriteRuleProgram' rule + +-- | `run` converts Kubaru DP +-- (for each \(i\), updates \( +-- \mathrm{dp}(j) \gets f(\mathrm{dp}(j), \mathrm{dp}(i)) +-- \) for each \(j \gt i\)) +-- to Morau DP +-- (for each \(i\), computes \( +-- \mathrm{dp}(i) = F(\lbrace \mathrm{dp}(j) \mid j \lt i \rbrace) +-- \)). +-- +-- == Examples +-- +-- Before: +-- +-- > foldl (fun dp i -> +-- > foldl (fun dp j -> +-- > setAt dp j ( +-- > f dp[j] dp[i]) +-- > ) dp (range (i + 1) n) +-- > ) dp (range n) +-- +-- After: +-- +-- > build (fun dp' -> +-- > foldl (fun dp_i j -> +-- > f dp_i dp'[j] +-- > ) dp[i] (range i) +-- > ) [] n +run :: (MonadAlpha m, MonadError Error m) => Program -> m Program +run prog = wrapError' "Jikka.Core.Convert.KubaruToMorau" $ do + precondition $ do + ensureWellTyped prog + prog <- runProgram prog + postcondition $ do + ensureWellTyped prog + return prog diff --git a/src/Jikka/Core/Convert/MakeScanl.hs b/src/Jikka/Core/Convert/MakeScanl.hs --- a/src/Jikka/Core/Convert/MakeScanl.hs +++ b/src/Jikka/Core/Convert/MakeScanl.hs @@ -32,8 +32,6 @@ import Control.Monad.Trans.Maybe import qualified Data.Map as M -import Data.Maybe -import qualified Data.Vector as V import Jikka.Common.Alpha import Jikka.Common.Error import Jikka.Core.Language.ArithmeticalExpr @@ -57,17 +55,6 @@ Scanl' t1 t2 f init (Cons' _ x xs) -> Just $ Cons' t2 init (Scanl' t1 t2 f (App2 f init x) xs) _ -> Nothing --- | `getRecurrenceFormulaBase` makes a pair @((a_0, ..., a_{k - 1}), a)@ from @setat (... (setat a 0 a_0) ...) (k - 1) a_{k - 1})@. -getRecurrenceFormulaBase :: Expr -> ([Expr], Expr) -getRecurrenceFormulaBase = go (V.replicate recurrenceLimit Nothing) - where - recurrenceLimit :: Num a => a - recurrenceLimit = 20 - go :: V.Vector (Maybe Expr) -> Expr -> ([Expr], Expr) - go base = \case - SetAt' _ e (LitInt' i) e' | 0 <= i && i < recurrenceLimit -> go (base V.// [(fromInteger i, Just e')]) e - e -> (map fromJust (takeWhile isJust (V.toList base)), e) - -- | `getRecurrenceFormulaStep1` removes `At` in @body@. getRecurrenceFormulaStep1 :: MonadAlpha m => Int -> Type -> VarName -> VarName -> Expr -> m (Maybe Expr) getRecurrenceFormulaStep1 shift t a i body = do @@ -112,9 +99,6 @@ return $ case go body of Just body -> Just $ Lam2 x (TupleTy ts) i IntTy (uncurryApp (Tuple' ts) (map (\i -> Proj' ts i (Var x)) [1 .. size - 1] ++ [body])) Nothing -> Nothing - -hoistMaybe :: Applicative m => Maybe a -> MaybeT m a -hoistMaybe = MaybeT . pure -- | -- * This assumes that `Range2` and `Range3` are already converted to `Range1` (`Jikka.Core.Convert.ShortCutFusion`). diff --git a/src/Jikka/Core/Convert/ShortCutFusion.hs b/src/Jikka/Core/Convert/ShortCutFusion.hs --- a/src/Jikka/Core/Convert/ShortCutFusion.hs +++ b/src/Jikka/Core/Convert/ShortCutFusion.hs @@ -36,6 +36,7 @@ import Jikka.Core.Language.BuiltinPatterns import Jikka.Core.Language.Expr import Jikka.Core.Language.FreeVars +import Jikka.Core.Language.LambdaPatterns import Jikka.Core.Language.Lint import Jikka.Core.Language.RewriteRules import Jikka.Core.Language.Util @@ -87,7 +88,7 @@ let return' = return . Just in RewriteRule $ \_ -> \case -- reduce `Map` - Map' _ _ (LamId _ _) xs -> return' xs + Map' _ _ (LamId _) xs -> return' xs -- reduce `Filter` Filter' t (Lam _ _ LitFalse) _ -> return' (Nil' t) Filter' _ (Lam _ _ LitTrue) xs -> return' xs @@ -104,7 +105,7 @@ let return' = return . Just in RewriteRule $ \_ -> \case -- reduce `Map` - Map' _ _ (LamId _ _) xs -> return' xs + Map' _ _ (LamId _) xs -> return' xs Map' _ t3 g (Map' t1 _ f xs) -> do x <- genVarName' let h = Lam x t1 (App g (App f (Var x))) @@ -127,7 +128,6 @@ -- reduce `Sorted` Sorted' t (Reversed' _ xs) -> return' $ Sorted' t xs Sorted' t (Sorted' _ xs) -> return' $ Sorted' t xs - -- others _ -> return Nothing reduceFoldMap :: MonadAlpha m => RewriteRule m @@ -149,6 +149,9 @@ x1 <- genVarName' return' $ Foldl' t1 t3 (Lam2 x3 t3 x1 t1 (App2 g (Var x3) (App f (Var x1)))) init xs -- others + Len' t (SetAt' _ xs _ _) -> return' $ Len' t xs + Len' t (Scanl' _ _ _ _ xs) -> return' $ Plus' (Len' t xs) (LitInt' 1) + At' t (SetAt' _ xs i' x) i -> return' $ If' t (Equal' IntTy i' i) x (At' t xs i) _ -> return Nothing reduceFold :: Monad m => RewriteRule m @@ -176,6 +179,7 @@ Elem' t y (Cons' _ x xs) -> return' $ And' (Equal' t x y) (Elem' t y xs) Elem' _ x (Range1' n) -> return' $ And' (LessEqual' IntTy Lit0 x) (LessThan' IntTy x n) -- others + Len' t (Build' _ _ base n) -> return' $ Plus' (Len' t base) n _ -> return Nothing rule :: MonadAlpha m => RewriteRule m @@ -196,7 +200,7 @@ -- | `run` does short cut fusion. -- -- * This function is mainly for polymorphic reductions. This dosn't do much about concrete things, e.g., arithmetical operations. --- * This doesn't do nothing about `Scanl` or `SetAt`. +-- * This does nothing about `Build`, `Scanl` or `SetAt` except combinations with `Len` or `At`. -- -- == Example -- diff --git a/src/Jikka/Core/Evaluate.hs b/src/Jikka/Core/Evaluate.hs --- a/src/Jikka/Core/Evaluate.hs +++ b/src/Jikka/Core/Evaluate.hs @@ -275,7 +275,9 @@ Var x -> case lookup x env of Nothing -> throwInternalError $ "undefined variable: " ++ unVarName x Just val -> return val - Lit lit -> literalToValue lit + Lit lit -> case lit of + LitBuiltin ConvexHullTrickInit -> callBuiltin ConvexHullTrickInit [] + _ -> literalToValue lit If' _ p e1 e2 -> do p <- valueToBool =<< evaluateExpr env p if p diff --git a/src/Jikka/Core/Format.hs b/src/Jikka/Core/Format.hs --- a/src/Jikka/Core/Format.hs +++ b/src/Jikka/Core/Format.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} -- | -- Module : Jikka.Core.Format @@ -24,26 +25,103 @@ import Data.List (intercalate) import Data.Text (Text, pack) import Jikka.Common.Format.AutoIndent +import Jikka.Core.Language.BuiltinPatterns (pattern Range1') import Jikka.Core.Language.Expr +import Jikka.Core.Language.FreeVars (isUnusedVar) +import Jikka.Core.Language.LambdaPatterns import Jikka.Core.Language.Util +-- | See also Table 2 of . +newtype Prec = Prec Int + deriving (Eq, Ord, Show, Read) + +instance Enum Prec where + toEnum n = Prec n + fromEnum (Prec n) = n + +identPrec = Prec 12 + +funCallPrec = Prec 11 + +unaryPrec = Prec 10 + +powerPrec = Prec 8 + +multPrec = Prec 7 + +addPrec = Prec 6 + +appendPrec = Prec 5 + +comparePrec = Prec 4 + +andPrec = Prec 3 + +orPrec = Prec 2 + +impliesPrec = Prec 1 + +commaPrec = Prec 0 + +lambdaPrec = Prec (-1) + +parenPrec = Prec (-2) + +data Assoc + = NoAssoc + | LeftToRight + | RightToLeft + deriving (Eq, Ord, Enum, Show, Read) + paren :: String -> String paren s = "(" ++ s ++ ")" -formatType :: Type -> String -formatType = \case - VarTy (TypeName a) -> a - IntTy -> "int" - BoolTy -> "bool" - ListTy t -> formatType t ++ " list" +-- | `resolvePrec` inserts parens to the given string if required. +-- +-- >>> resolvePrec multPrec ("1 + 2", addPrec) ++ " * 3" +-- "(1 + 2) * 3" +-- +-- >>> resolvePrec addPrec ("1 * 2", multPrec) ++ " + 3" +-- "1 * 2 + 3" +resolvePrec :: Prec -> (String, Prec) -> String +resolvePrec cur (s, prv) + | cur > prv = paren s + | otherwise = s + +-- | `resolvePrecLeft` inserts parens to the given string if required. +-- +-- >>> resolvePrecLeft addPrec LeftToRight ("1 - 2", addPrec) ++ " - 3" +-- "1 - 2 - 3" +resolvePrecLeft :: Prec -> Assoc -> (String, Prec) -> String +resolvePrecLeft cur assoc (s, prv) + | cur > prv || (cur == prv && assoc /= LeftToRight) = paren s + | otherwise = s + +-- | `resolvePrecRight` inserts parens to the given string if required. +-- +-- >>> "1 - " ++ resolvePrecRight addPrec LeftToRight ("2 - 3", addPrec) +-- "1 - (2 - 3)" +resolvePrecRight :: Prec -> Assoc -> (String, Prec) -> String +resolvePrecRight cur assoc (s, prv) + | cur > prv || (cur == prv && assoc /= RightToLeft) = paren s + | otherwise = s + +formatType' :: Type -> (String, Prec) +formatType' = \case + VarTy (TypeName a) -> (a, identPrec) + IntTy -> ("int", identPrec) + BoolTy -> ("bool", identPrec) + ListTy t -> (resolvePrec funCallPrec (formatType' t) ++ " list", funCallPrec) TupleTy ts -> case ts of - [t] -> paren $ formatType t ++ "," - _ -> paren $ intercalate " * " (map formatType ts) - t@(FunTy _ _) -> - let (ts, ret) = uncurryFunTy t - in paren $ intercalate " -> " (map formatType (ts ++ [ret])) - DataStructureTy ds -> formatDataStructure ds + [t] -> (resolvePrec (pred multPrec) (formatType' t) ++ ",", multPrec) + _ -> (intercalate " * " (map (resolvePrec (pred multPrec) . formatType') ts), multPrec) + FunTy t1 t2 -> + (resolvePrecLeft impliesPrec RightToLeft (formatType' t1) ++ " -> " ++ resolvePrecRight impliesPrec RightToLeft (formatType' t2), impliesPrec) + DataStructureTy ds -> (formatDataStructure ds, identPrec) +formatType :: Type -> String +formatType = resolvePrec parenPrec . formatType' + formatDataStructure :: DataStructure -> String formatDataStructure = \case ConvexHullTrick -> "convex-hull-trick" @@ -57,49 +135,52 @@ data Builtin' = Fun [Type] String - | PrefixOp String - | InfixOp [Type] String + | PrefixOp [Type] String + | InfixOp [Type] String Prec Assoc | At' Type + | SetAt' Type + | Tuple' [Type] + | Proj' [Type] Integer | If' Type deriving (Eq, Ord, Show, Read) fun :: String -> Builtin' fun = Fun [] -infixOp :: String -> Builtin' +infixOp :: String -> Prec -> Assoc -> Builtin' infixOp = InfixOp [] analyzeBuiltin :: Builtin -> Builtin' analyzeBuiltin = \case -- arithmetical functions - Negate -> PrefixOp "negate" - Plus -> infixOp "+" - Minus -> infixOp "-" - Mult -> infixOp "*" - FloorDiv -> infixOp "/" - FloorMod -> infixOp "%" - CeilDiv -> fun "ceildiv" - CeilMod -> fun "ceilmod" - Pow -> infixOp "**" + Negate -> PrefixOp [] "-" + Plus -> infixOp "+" addPrec LeftToRight + Minus -> infixOp "-" addPrec LeftToRight + Mult -> infixOp "*" multPrec LeftToRight + FloorDiv -> infixOp "/" multPrec LeftToRight + FloorMod -> infixOp "%" multPrec LeftToRight + CeilDiv -> infixOp "/^" multPrec LeftToRight + CeilMod -> infixOp "%^" multPrec LeftToRight + Pow -> infixOp "**" powerPrec RightToLeft -- advanced arithmetical functions Abs -> fun "abs" Gcd -> fun "gcd" Lcm -> fun "lcm" - Min2 t -> Fun [t] "min" - Max2 t -> Fun [t] "max" + Min2 t -> InfixOp [t] " InfixOp [t] ">?" appendPrec LeftToRight -- logical functions - Not -> PrefixOp "not" - And -> infixOp "and" - Or -> infixOp "or" - Implies -> infixOp "implies" + Not -> PrefixOp [] "not" + And -> infixOp "and" andPrec RightToLeft + Or -> infixOp "or" orPrec RightToLeft + Implies -> infixOp "implies" impliesPrec RightToLeft If t -> If' t -- bitwise functions - BitNot -> PrefixOp "~" - BitAnd -> infixOp "&" - BitOr -> infixOp "|" - BitXor -> infixOp "^" - BitLeftShift -> infixOp "<<" - BitRightShift -> infixOp ">>" + BitNot -> PrefixOp [] "~" + BitAnd -> infixOp "&" multPrec LeftToRight + BitOr -> infixOp "|" appendPrec LeftToRight + BitXor -> infixOp "^" addPrec LeftToRight + BitLeftShift -> infixOp "<<" powerPrec LeftToRight + BitRightShift -> infixOp ">>" powerPrec LeftToRight -- matrix functions MatAp _ _ -> fun "matap" MatZero _ -> fun "matzero" @@ -131,33 +212,33 @@ Map t1 t2 -> Fun [t1, t2] "map" Filter t -> Fun [t] "filter" At t -> At' t - SetAt t -> Fun [t] "setAt" + SetAt t -> SetAt' t Elem t -> Fun [t] "elem" Sum -> fun "sum" Product -> fun "product" ModSum -> fun "modsum" ModProduct -> fun "modproduct" - Min1 t -> Fun [t] "min1" - Max1 t -> Fun [t] "max1" + Min1 t -> Fun [t] "min" + Max1 t -> Fun [t] "max" ArgMin t -> Fun [t] "argmin" ArgMax t -> Fun [t] "argmax" All -> fun "all" Any -> fun "any" Sorted t -> Fun [t] "sort" Reversed t -> Fun [t] "reverse" - Range1 -> fun "range1" + Range1 -> fun "range" Range2 -> fun "range2" Range3 -> fun "range3" -- tuple functions - Tuple ts -> Fun ts "tuple" - Proj ts n -> Fun ts ("proj" ++ show n) + Tuple ts -> Tuple' ts + Proj ts n -> Proj' ts (toInteger n) -- comparison - LessThan t -> InfixOp [t] "<" - LessEqual t -> InfixOp [t] "<=" - GreaterThan t -> InfixOp [t] ">" - GreaterEqual t -> InfixOp [t] ">=" - Equal t -> InfixOp [t] "==" - NotEqual t -> InfixOp [t] "!=" + LessThan t -> InfixOp [t] "<" comparePrec NoAssoc + LessEqual t -> InfixOp [t] "<=" comparePrec NoAssoc + GreaterThan t -> InfixOp [t] ">" comparePrec NoAssoc + GreaterEqual t -> InfixOp [t] ">=" comparePrec NoAssoc + Equal t -> InfixOp [t] "==" comparePrec NoAssoc + NotEqual t -> InfixOp [t] "!=" comparePrec NoAssoc -- combinational functions Fact -> fun "fact" Choose -> fun "choose" @@ -176,33 +257,41 @@ [] -> "" ts -> "<" ++ intercalate ", " (map formatType ts) ++ ">" -formatFunCall :: String -> [Expr] -> String +formatFunCall :: (String, Prec) -> [Expr] -> (String, Prec) formatFunCall f = \case [] -> f - args -> f ++ "(" ++ intercalate ", " (map formatExpr' args) ++ ")" + args -> (resolvePrec funCallPrec f ++ "(" ++ intercalate ", " (map (resolvePrec commaPrec . formatExpr') args) ++ ")", funCallPrec) formatBuiltinIsolated' :: Builtin' -> String formatBuiltinIsolated' = \case Fun ts name -> name ++ formatTemplate ts - PrefixOp op -> paren op - InfixOp ts op -> paren $ op ++ formatTemplate ts + PrefixOp ts op -> paren $ op ++ formatTemplate ts + InfixOp ts op _ _ -> paren $ op ++ formatTemplate ts At' t -> paren $ "at" ++ formatTemplate [t] + SetAt' t -> paren $ "set-at" ++ formatTemplate [t] + Tuple' ts -> paren $ "tuple" ++ formatTemplate ts + Proj' ts n -> paren $ "proj-" ++ show n ++ formatTemplate ts If' t -> paren $ "if-then-else" ++ formatTemplate [t] formatBuiltinIsolated :: Builtin -> String formatBuiltinIsolated = formatBuiltinIsolated' . analyzeBuiltin -formatBuiltin' :: Builtin' -> [Expr] -> String +formatBuiltin' :: Builtin' -> [Expr] -> (String, Prec) formatBuiltin' builtin args = case (builtin, args) of - (Fun _ name, _) -> formatFunCall name args - (PrefixOp op, e1 : args) -> formatFunCall (paren $ op ++ " " ++ formatExpr' e1) args - (InfixOp _ op, e1 : e2 : args) -> formatFunCall (paren $ formatExpr' e1 ++ " " ++ op ++ " " ++ formatExpr' e2) args - (At' _, e1 : e2 : args) -> formatFunCall (paren $ formatExpr' e1 ++ ")[" ++ formatExpr' e2 ++ "]") args - (If' _, e1 : e2 : e3 : args) -> formatFunCall (paren $ "if" ++ " " ++ formatExpr' e1 ++ " then " ++ formatExpr' e2 ++ " else " ++ formatExpr' e3) args - _ -> formatFunCall (formatBuiltinIsolated' builtin) args + (Fun _ "map", [Lam x IntTy e, Range1' n]) | x `isUnusedVar` e -> formatFunCall ("replicate", identPrec) [n, e] + (Fun _ name, _) -> formatFunCall (name, identPrec) args + (PrefixOp _ op, e1 : args) -> formatFunCall (op ++ " " ++ resolvePrec unaryPrec (formatExpr' e1), unaryPrec) args + (InfixOp _ op prec assoc, e1 : e2 : args) -> formatFunCall (resolvePrecLeft prec assoc (formatExpr' e1) ++ " " ++ op ++ " " ++ resolvePrecRight prec assoc (formatExpr' e2), prec) args + (At' _, e1 : e2 : args) -> formatFunCall (resolvePrec identPrec (formatExpr' e1) ++ "[" ++ resolvePrec parenPrec (formatExpr' e2) ++ "]", identPrec) args + (SetAt' _, e1 : e2 : e3 : args) -> formatFunCall (resolvePrec identPrec (formatExpr' e1) ++ "[" ++ resolvePrec parenPrec (formatExpr' e2) ++ " := " ++ resolvePrec parenPrec (formatExpr' e3) ++ "]", identPrec) args + (Tuple' [_], e : args) -> formatFunCall (paren (resolvePrec commaPrec (formatExpr' e) ++ ","), identPrec) args + (Tuple' ts, args) | length args >= length ts -> formatFunCall (paren (intercalate ", " (map (resolvePrec commaPrec . formatExpr') (take (length ts) args))), identPrec) (drop (length ts) args) + (Proj' _ n, e : args) -> formatFunCall (resolvePrec identPrec (formatExpr' e) ++ "." ++ show n, identPrec) args + (If' _, e1 : e2 : e3 : args) -> formatFunCall ("if" ++ " " ++ resolvePrec parenPrec (formatExpr' e1) ++ " then " ++ resolvePrec parenPrec (formatExpr' e2) ++ " else " ++ resolvePrec lambdaPrec (formatExpr' e3), lambdaPrec) args + _ -> formatFunCall (formatBuiltinIsolated' builtin, identPrec) args formatBuiltin :: Builtin -> [Expr] -> String -formatBuiltin = formatBuiltin' . analyzeBuiltin +formatBuiltin f args = resolvePrec parenPrec (formatBuiltin' (analyzeBuiltin f) args) formatLiteral :: Literal -> String formatLiteral = \case @@ -215,33 +304,35 @@ formatFormalArgs :: [(VarName, Type)] -> String formatFormalArgs args = unwords $ map (\(x, t) -> paren (unVarName x ++ ": " ++ formatType t)) args -formatExpr' :: Expr -> String +formatExpr' :: Expr -> (String, Prec) formatExpr' = \case - Var x -> unVarName x - Lit lit -> formatLiteral lit + Var x -> (unVarName x, identPrec) + Lit lit -> (formatLiteral lit, identPrec) e@(App _ _) -> let (f, args) = curryApp e in case f of - Var x -> formatFunCall (unVarName x) args - Lit (LitBuiltin builtin) -> formatBuiltin builtin args + Var x -> formatFunCall (unVarName x, identPrec) args + Lit (LitBuiltin builtin) -> (formatBuiltin builtin args, identPrec) _ -> formatFunCall (formatExpr' f) args + LamId _ -> ("id", identPrec) + LamConst _ e -> formatFunCall ("const", identPrec) [e] e@(Lam _ _ _) -> let (args, body) = uncurryLam e - in paren $ "fun " ++ formatFormalArgs args ++ " ->\n" ++ indent ++ "\n" ++ formatExpr' body ++ "\n" ++ dedent ++ "\n" - Let x t e1 e2 -> "let " ++ unVarName x ++ ": " ++ formatType t ++ " =\n" ++ indent ++ "\n" ++ formatExpr' e1 ++ "\n" ++ dedent ++ "\nin " ++ formatExpr' e2 + in ("fun " ++ formatFormalArgs args ++ " ->\n" ++ indent ++ "\n" ++ resolvePrec parenPrec (formatExpr' body) ++ "\n" ++ dedent ++ "\n", lambdaPrec) + Let x t e1 e2 -> ("let " ++ unVarName x ++ ": " ++ formatType t ++ " =\n" ++ indent ++ "\n" ++ resolvePrec parenPrec (formatExpr' e1) ++ "\n" ++ dedent ++ "\nin " ++ resolvePrec lambdaPrec (formatExpr' e2), lambdaPrec) formatExpr :: Expr -> String -formatExpr = unwords . makeIndentFromMarkers 4 . lines . formatExpr' +formatExpr = unlines . makeIndentFromMarkers 4 . lines . resolvePrec parenPrec . formatExpr' formatToplevelExpr :: ToplevelExpr -> [String] formatToplevelExpr = \case - ResultExpr e -> lines (formatExpr' e) + ResultExpr e -> lines (resolvePrec lambdaPrec (formatExpr' e)) ToplevelLet x t e cont -> let' (unVarName x) t e cont ToplevelLetRec f args ret e cont -> let' ("rec " ++ unVarName f ++ " " ++ formatFormalArgs args) ret e cont where let' s t e cont = ["let " ++ s ++ ": " ++ formatType t ++ " =", indent] - ++ lines (formatExpr' e) + ++ lines (resolvePrec parenPrec (formatExpr' e)) ++ [dedent, "in"] ++ formatToplevelExpr cont diff --git a/src/Jikka/Core/Language/Expr.hs b/src/Jikka/Core/Language/Expr.hs --- a/src/Jikka/Core/Language/Expr.hs +++ b/src/Jikka/Core/Language/Expr.hs @@ -373,11 +373,6 @@ pattern Lam3 x1 t1 x2 t2 x3 t3 e = Lam x1 t1 (Lam x2 t2 (Lam x3 t3 e)) -pattern LamId x t <- - (\case Lam x t (Var y) | x == y -> Just (x, t); _ -> Nothing -> Just (x, t)) - where - LamId x t = Lam x t (Var x) - -- | `ToplevelExpr` is the toplevel exprs. In our core, "let rec" is allowed only on the toplevel. -- -- \[ diff --git a/src/Jikka/Core/Language/LambdaPatterns.hs b/src/Jikka/Core/Language/LambdaPatterns.hs new file mode 100644 --- /dev/null +++ b/src/Jikka/Core/Language/LambdaPatterns.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} + +module Jikka.Core.Language.LambdaPatterns where + +import Jikka.Core.Language.Expr +import Jikka.Core.Language.FreeVars + +pattern LamId t <- + (\case Lam x t (Var y) | x == y -> Just t; _ -> Nothing -> Just t) + where + LamId t = Lam "x" t (Var "x") + +pattern LamConst t e <- + (\case Lam x t e | x `isUnusedVar` e -> Just (t, e); _ -> Nothing -> Just (t, e)) + where + LamConst t e = Lam (findUnusedVarName' e) t e diff --git a/src/Jikka/Core/Language/Util.hs b/src/Jikka/Core/Language/Util.hs --- a/src/Jikka/Core/Language/Util.hs +++ b/src/Jikka/Core/Language/Util.hs @@ -3,10 +3,13 @@ module Jikka.Core.Language.Util where +import Control.Arrow import Control.Monad.Identity +import Control.Monad.Trans.Maybe import Control.Monad.Writer (execWriter, tell) -import Data.Maybe (isJust) +import Data.Maybe import Data.Monoid (Dual (..)) +import qualified Data.Vector as V import Jikka.Common.Alpha import Jikka.Common.Error import Jikka.Core.Language.BuiltinPatterns @@ -352,3 +355,23 @@ Lam x t body -> Lam x t <$> (if x == f then return body else go body) Let y _ _ _ | y == i -> throwInternalError "Jikka.Core.Language.Util.replaceLenF: name conflict" Let y t e1 e2 -> Let y t <$> go e1 <*> (if y == f then return e2 else go e2) + +-- | `getRecurrenceFormulaBase` makes a pair @((a_0, ..., a_{k - 1}), a)@ from @setat (... (setat a 0 a_0) ...) (k - 1) a_{k - 1})@. +getRecurrenceFormulaBase :: Expr -> ([Expr], Expr) +getRecurrenceFormulaBase = go (V.replicate recurrenceLimit Nothing) + where + recurrenceLimit :: Num a => a + recurrenceLimit = 20 + go :: V.Vector (Maybe (Expr, Type)) -> Expr -> ([Expr], Expr) + go base = \case + SetAt' t e (LitInt' i) e' + | 0 <= i && i < recurrenceLimit -> go (base V.// [(fromInteger i, Just (e', t))]) e + | otherwise -> second (\e -> SetAt' t e (LitInt' i) e') $ go base e + e -> + let (base', base'') = span isJust (V.toList base) + base''' = map (fst . fromJust) base' + e'' = foldr (\(i, e') e -> maybe id (\(e', t) e -> SetAt' t e (LitInt' i) e') e' e) e (zip [toInteger (length base') ..] base'') + in (base''', e'') + +hoistMaybe :: Applicative m => Maybe a -> MaybeT m a +hoistMaybe = MaybeT . pure diff --git a/src/Jikka/Main.hs b/src/Jikka/Main.hs --- a/src/Jikka/Main.hs +++ b/src/Jikka/Main.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + -- | -- Module : Jikka.Main -- Description : is the entry point of the @jikka@ command. / @jikka@ コマンドのエントリポイントです。 @@ -9,8 +11,10 @@ module Jikka.Main where import Data.Maybe (fromMaybe) +import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Version (showVersion) +import qualified Jikka.CPlusPlus.Convert.BundleRuntime as BundleRuntime import Jikka.Common.Error import Jikka.Common.Format.Error (hPrintError, hPrintErrorWithText) import qualified Jikka.Main.Subcommand.Convert as Convert @@ -27,11 +31,15 @@ | Verbose | Version | Target String + | BundleRuntimeHeaders Bool + | EmbedOriginalCode Bool deriving (Eq, Ord, Show, Read) data Options = Options { verbose :: Bool, - target :: Maybe Target + target :: Maybe Target, + bundleRuntimeHeaders :: Bool, + embedOriginalCode :: Bool } deriving (Eq, Ord, Show, Read) @@ -39,7 +47,9 @@ defaultOptions = Options { verbose = False, - target = Nothing + target = Nothing, + bundleRuntimeHeaders = True, + embedOriginalCode = True } header :: String -> String @@ -50,7 +60,11 @@ [ Option ['h', '?'] ["help"] (NoArg Help) "", Option ['v'] ["verbose"] (NoArg Verbose) "", Option [] ["version"] (NoArg Version) "", - Option [] ["target"] (ReqArg Target "TARGET") "\"python\", \"rpython\", \"core\" or \"cxx\"" + Option [] ["target"] (ReqArg Target "TARGET") "\"python\", \"rpython\", \"core\" or \"cxx\"", + Option [] ["bundle-runtime-headers"] (NoArg (BundleRuntimeHeaders True)) "bundles C++ runtime headers", + Option [] ["no-bundle-runtime-headers"] (NoArg (BundleRuntimeHeaders False)) "", + Option [] ["embed-original-code"] (NoArg (EmbedOriginalCode True)) "embeds the original Python code", + Option [] ["no-embed-original-code"] (NoArg (EmbedOriginalCode False)) "" ] main :: String -> [String] -> IO ExitCode @@ -61,7 +75,7 @@ putStr usage return ExitSuccess (parsed, _, []) | Version `elem` parsed -> do - putStrLn $ showVersion version + putStrLn $ 'v' : showVersion version return ExitSuccess (parsed, [subcmd, path], []) -> case parseFlags name parsed of Left err -> do @@ -97,12 +111,26 @@ Target target -> do target <- parseTarget target go (opts {target = Just target}) flags + BundleRuntimeHeaders p -> go (opts {bundleRuntimeHeaders = p}) flags + EmbedOriginalCode p -> go (opts {embedOriginalCode = p}) flags runSubcommand :: String -> Options -> FilePath -> ExceptT Error IO () runSubcommand subcmd opts path = case subcmd of "convert" -> do input <- liftIO $ T.readFile path - output <- liftEither $ Convert.run (fromMaybe CPlusPlusTarget (target opts)) path input + let target' = fromMaybe CPlusPlusTarget (target opts) + output <- liftEither $ Convert.run target' path input + output <- + if target' == CPlusPlusTarget && bundleRuntimeHeaders opts + then BundleRuntime.run output + else return output + output <- + return $ + if embedOriginalCode opts + then + let headers = ["// This C++ code is transpiled using Jikka transpiler v" <> T.pack (showVersion version) <> " https://github.com/kmyk/Jikka", "// The original Python code:"] + in T.unlines (headers ++ map ("// " <>) (T.lines input)) <> output + else output liftIO $ T.putStr output "debug" -> Debug.run path "execute" -> Execute.run (fromMaybe CoreTarget (target opts)) path diff --git a/test/Jikka/Core/FormatSpec.hs b/test/Jikka/Core/FormatSpec.hs --- a/test/Jikka/Core/FormatSpec.hs +++ b/test/Jikka/Core/FormatSpec.hs @@ -39,8 +39,8 @@ [ "let rec solve$0 (n$1: int): int =", " let xs$2: int list =", " map((fun (i$3: int) ->", - " (i$3 * i$3)", - " ), range1(n$1))", + " i$3 * i$3", + " ), range(n$1))", " in sum(xs$2)", "in", "solve$0" diff --git a/test/Jikka/RestrictedPython/Convert/ToCoreSpec.hs b/test/Jikka/RestrictedPython/Convert/ToCoreSpec.hs --- a/test/Jikka/RestrictedPython/Convert/ToCoreSpec.hs +++ b/test/Jikka/RestrictedPython/Convert/ToCoreSpec.hs @@ -72,26 +72,26 @@ " 0", " in let b: $1 =", " 1", - " in let $4: ($5 * $6) =", - " foldl((fun ($4: ($5 * $6)) ($3: $2) ->", + " in let $4: $5 * $6 =", + " foldl((fun ($4: $5 * $6) ($3: $2) ->", " let b: $5 =", - " proj0($4)", + " $4.0", " in let a: $6 =", - " proj1($4)", + " $4.1", " in let i: $7 =", " $3", " in let c: $8 =", - " (a + b)", + " a + b", " in let a: $9 =", " b", " in let b: $10 =", " c", - " in tuple(b, a)", - " ), tuple(b, a), range1(n))", + " in (b, a)", + " ), (b, a), range(n))", " in let b: $5 =", - " proj0($4)", + " $4.0", " in let a: $6 =", - " proj1($4)", + " $4.1", " in a", "in", "solve" @@ -115,14 +115,14 @@ let expected = unlines [ "let rec solve : int =", - " let $2: ($1,) =", - " (if true then let x: $3 =", + " let $2: $1, =", + " if true then let x: $3 =", " 1", - " in tuple(x) else let x: $5 =", + " in (x,) else let x: $5 =", " 0", - " in tuple(x))", + " in (x,)", " in let x: $1 =", - " proj0($2)", + " $2.0", " in x", "in", "solve"