Jikka 5.0.11.2 → 5.1.0.0
raw patch · 33 files changed
+1519/−249 lines, 33 filesdep +directorydep +template-haskell
Dependencies added: directory, template-haskell
Files
- CHANGELOG.md +23/−21
- Jikka.cabal +31/−1
- README.md +39/−18
- runtime/include/jikka/convex_hull_trick.hpp +128/−0
- runtime/include/jikka/divmod.hpp +36/−0
- runtime/include/jikka/error.hpp +21/−0
- runtime/include/jikka/matrix.hpp +81/−0
- runtime/include/jikka/modulo.hpp +107/−0
- runtime/include/jikka/modulo_matrix.hpp +96/−0
- runtime/include/jikka/not_modulo.hpp +67/−0
- runtime/include/jikka/range.hpp +25/−0
- runtime/include/jikka/segment_tree.hpp +28/−0
- runtime/include/jikka/slope_trick.hpp +162/−0
- src/Jikka/CPlusPlus/Convert/BundleRuntime.hs +122/−0
- src/Jikka/CPlusPlus/Convert/FromCore.hs +27/−25
- src/Jikka/CPlusPlus/Convert/MoveSemantics.hs +20/−9
- src/Jikka/CPlusPlus/Format.hs +15/−6
- src/Jikka/CPlusPlus/Language/VariableAnalysis.hs +1/−1
- src/Jikka/Common/FileEmbed.hs +33/−0
- src/Jikka/Core/Convert.hs +2/−0
- src/Jikka/Core/Convert/CloseMin.hs +2/−2
- src/Jikka/Core/Convert/ConvexHullTrick.hs +76/−48
- src/Jikka/Core/Convert/KubaruToMorau.hs +113/−0
- src/Jikka/Core/Convert/MakeScanl.hs +0/−16
- src/Jikka/Core/Convert/ShortCutFusion.hs +8/−4
- src/Jikka/Core/Evaluate.hs +3/−1
- src/Jikka/Core/Format.hs +161/−70
- src/Jikka/Core/Language/Expr.hs +0/−5
- src/Jikka/Core/Language/LambdaPatterns.hs +19/−0
- src/Jikka/Core/Language/Util.hs +24/−1
- src/Jikka/Main.hs +33/−5
- test/Jikka/Core/FormatSpec.hs +2/−2
- test/Jikka/RestrictedPython/Convert/ToCoreSpec.hs +14/−14
CHANGELOG.md view
@@ -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: <https://hackage.haskell.org/package/Jikka>@@ -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 <algorithm> #include <cstdint>@@ -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: <https://atcoder.jp/contests/abc134/submissions/6526623> -``` c+++```c++ vector<int64_t> solve(int64_t N, const vector<int64_t> & A) { vector<int64_t> 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<int64_t> & 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<int64_t> & A, int64_t N) { int64_t t0 = 0; for (int64_t i = 0; i < N; ++ i) {
Jikka.cabal view
@@ -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 <https://github.com/kmyk/Jikka> 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
README.md view
@@ -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 <algorithm> #include <cstdint>@@ -173,7 +195,6 @@ } } ```- ## License
+ runtime/include/jikka/convex_hull_trick.hpp view
@@ -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 <cassert>+#include <climits>+#include <cstdint>+#include <map>+#include <set>+#include <utility>++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<line_t> lines;+ std::map<rational_t, line_t> cross;+ template <typename Iterator> 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
+ runtime/include/jikka/divmod.hpp view
@@ -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 <cassert>+#include <cstdint>++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
+ runtime/include/jikka/error.hpp view
@@ -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 <cassert>+#include <iostream>+#include <string>++namespace jikka {++template <class T> inline T error(const std::string &message) {+ std::cerr << message << std::endl;+ assert(false);+}++} // namespace jikka++#endif // JIKKA_ERROR_HPP
+ runtime/include/jikka/matrix.hpp view
@@ -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 <array>++namespace jikka {++template <typename T, size_t H, size_t W>+using matrix = std::array<std::array<T, W>, H>;++namespace mat {++template <size_t H, size_t W>+std::array<int64_t, H> ap(const matrix<int64_t, H, W> &a,+ const std::array<int64_t, W> &b) {+ std::array<int64_t, H> 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 <size_t N> matrix<int64_t, N, N> zero() { return {}; }++template <size_t N> matrix<int64_t, N, N> one() {+ matrix<int64_t, N, N> a = {};+ for (size_t i = 0; i < N; ++i) {+ a[i][i] = 1;+ }+ return a;+}++template <size_t H, size_t W>+matrix<int64_t, H, W> add(const matrix<int64_t, H, W> &a,+ const matrix<int64_t, H, W> &b) {+ matrix<int64_t, H, W> 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 <size_t H, size_t N, size_t W>+matrix<int64_t, H, W> mul(const matrix<int64_t, H, N> &a,+ const matrix<int64_t, N, W> &b) {+ matrix<int64_t, H, W> 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 <size_t N>+matrix<int64_t, N, N> pow(matrix<int64_t, N, N> x, int64_t k) {+ matrix<int64_t, N, N> y = one<N>();+ 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
+ runtime/include/jikka/modulo.hpp view
@@ -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 <algorithm>+#include <cassert>+#include <cstdint>+#include <unordered_map>++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<int64_t, std::vector<int64_t>> memos;+ auto &memo = memos[MOD];+ while (static_cast<int64_t>(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
+ runtime/include/jikka/modulo_matrix.hpp view
@@ -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 <array>++namespace jikka {++namespace modmat {++using jikka::floormod;++template <size_t N>+std::array<int64_t, N> floormod(std::array<int64_t, N> x, int64_t MOD) {+ for (size_t i = 0; i < N; ++i) {+ x[i] = floormod(x[i], MOD);+ }+ return x;+}++template <size_t H, size_t W>+matrix<int64_t, H, W> floormod(matrix<int64_t, H, W> 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 <size_t H, size_t W>+std::array<int64_t, H> ap(const matrix<int64_t, H, W> &a,+ const std::array<int64_t, W> &b, int64_t MOD) {+ std::array<int64_t, H> 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 <size_t H, size_t W>+matrix<int64_t, H, W> add(const matrix<int64_t, H, W> &a,+ const matrix<int64_t, H, W> &b, int64_t MOD) {+ matrix<int64_t, H, W> 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 <size_t H, size_t N, size_t W>+matrix<int64_t, H, W> mul(const matrix<int64_t, H, N> &a,+ const matrix<int64_t, N, W> &b, int64_t MOD) {+ matrix<int64_t, H, W> 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 <size_t N>+matrix<int64_t, N, N> pow(matrix<int64_t, N, N> x, int64_t k, int64_t MOD) {+ matrix<int64_t, N, N> y = mat::one<N>();+ 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
+ runtime/include/jikka/not_modulo.hpp view
@@ -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 <cassert>+#include <cstdint>++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
+ runtime/include/jikka/range.hpp view
@@ -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 <cstdint>+#include <numeric>+#include <vector>++namespace jikka {++inline std::vector<int64_t> range(int64_t n) {+ if (n < 0) {+ return std::vector<int64_t>();+ }+ std::vector<int64_t> xs(n);+ std::iota(xs.begin(), xs.end(), 0);+ return xs;+}++} // namespace jikka++#endif // JIKKA_RANGE_HPP
+ runtime/include/jikka/segment_tree.hpp view
@@ -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 <climits>+#include <functional>++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
+ runtime/include/jikka/slope_trick.hpp view
@@ -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 <algorithm>+#include <functional>+#include <limits>+#include <queue>+#include <vector>++namespace jikka {++template <typename T> struct slope_trick {++ const T INF = std::numeric_limits<T>::max() / 3;++ T min_f;+ std::priority_queue<T, std::vector<T>, std::less<>> L;+ std::priority_queue<T, std::vector<T>, 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
+ src/Jikka/CPlusPlus/Convert/BundleRuntime.hs view
@@ -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 <https://github.com/online-judge-tools/verification-helper `oj-bundle` command>.+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)
src/Jikka/CPlusPlus/Convert/FromCore.hs view
@@ -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]
src/Jikka/CPlusPlus/Convert/MoveSemantics.hs view
@@ -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]
src/Jikka/CPlusPlus/Format.hs view
@@ -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 <atcoder/segtree>")+ (\(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 <atcoder/segtree>"),+ (["jikka::slope_trick"], "#include \"jikka/slope_trick.hpp\"") ] in standardHeaders ++ additionalHeader ++ body
src/Jikka/CPlusPlus/Language/VariableAnalysis.hs view
@@ -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)
+ src/Jikka/Common/FileEmbed.hs view
@@ -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 <https://hackage.haskell.org/package/file-embed/docs/Data-FileEmbed.html#v:embedDir @embedDir@>.+--+-- == 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)]|]
src/Jikka/Core/Convert.hs view
@@ -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
src/Jikka/Core/Convert/CloseMin.hs view
@@ -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
src/Jikka/Core/Convert/ConvexHullTrick.hs view
@@ -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
+ src/Jikka/Core/Convert/KubaruToMorau.hs view
@@ -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
src/Jikka/Core/Convert/MakeScanl.hs view
@@ -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`).
src/Jikka/Core/Convert/ShortCutFusion.hs view
@@ -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 --
src/Jikka/Core/Evaluate.hs view
@@ -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
src/Jikka/Core/Format.hs view
@@ -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 <https://www.haskell.org/onlinereport/decls.html Haskell Online Report, 4 Declarations and Bindings>.+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] "<?" appendPrec LeftToRight+ Max2 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
src/Jikka/Core/Language/Expr.hs view
@@ -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. -- -- \[
+ src/Jikka/Core/Language/LambdaPatterns.hs view
@@ -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
src/Jikka/Core/Language/Util.hs view
@@ -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
src/Jikka/Main.hs view
@@ -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
test/Jikka/Core/FormatSpec.hs view
@@ -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"
test/Jikka/RestrictedPython/Convert/ToCoreSpec.hs view
@@ -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"