egison 4.1.1 → 4.1.2
raw patch · 26 files changed
+768/−1063 lines, 26 filesdep ~basedep ~sweet-egison
Dependency ranges changed: base, sweet-egison
Files
- Changelog.md +65/−0
- README.md +359/−0
- benchmark/Benchmark.hs +19/−11
- benchmark/collection-bench-cons-large.egi +11/−0
- benchmark/collection-bench-cons.egi +11/−0
- benchmark/collection-bench-snoc.egi +11/−0
- benchmark/fact-30000.egi +6/−0
- benchmark/prime-pairs-2.egi +53/−0
- benchmark/prime-pairs-6.egi +53/−0
- egison.cabal +36/−8
- hs-src/Interpreter/egison.hs +16/−13
- hs-src/Language/Egison.hs +3/−0
- hs-src/Language/Egison/CmdOptions.hs +23/−20
- hs-src/Language/Egison/Completion.hs +2/−2
- hs-src/Language/Egison/Core.hs +4/−3
- hs-src/Language/Egison/Eval.hs +2/−1
- test/OptionsTest.hs +84/−0
- test/Test.hs +4/−4
- test/dp.egi +0/−47
- test/fixture/a.egi +1/−0
- test/fixture/b.egi +3/−0
- test/fixture/c.egi +2/−0
- test/poker-joker.egi +0/−37
- test/poker.egi +0/−39
- test/primitive.egi +0/−159
- test/syntax.egi +0/−719
+ Changelog.md view
@@ -0,0 +1,65 @@+# Changelog++## Latest++## 4.1.0+### New Features+* Enabled user-defined infixes for expressions and patterns: <https://egison.readthedocs.io/en/latest/reference/basic-syntax.html#infix-declaration>+* Allowed `let` expression to decompose data. Unlike `match` expressions (of Egison), this does not require matchers and the decomposition pattern is limited.+```+> let (x :: _) := [1, 2, 3] in x+1+> let (x :: _) := [] in x+Primitive data pattern match failed+ stack trace: <stdin>+```+* Enabled data decomposition at lambda arguments.+```+> (\(x, _) -> x) (1, 2)+1+```+* Implemented partial application.+```+> let add x y := x + y in map (add 1) [1, 2, 3]+[2, 3, 4]+```+* Huge speedup in mathematical programs:+ * Reimplemented math normalization, which was originally implemented in Egison, to the interpreter in Haskell.+ * Implemented lazy evaluation on tensor elements.+* Added new syntax for symmetric / anti-symmetric tensors.++### Backward-incompatible Changes++* Changed the syntax to start definitions with `def` keyword.+```+def x := 1+```++* `io` was previously defined as a syntastic constructs, but it is changed into a primitive function.+Namely, users will need to wrap the arguments to `io` in a parenthesis, or insert `$` after `io`.+```+-- Invalid+io isEof ()++-- OK+io (isEOF ())+io $ isEOF ()+```++### Miscellaneous+* Added a command line option `--no-normalize` to turn off math normalization implemented in the standard math library.+* Revived TSV input options: <https://egison.readthedocs.io/en/latest/reference/command-line-options.html#reading-tsv-input>+* Deprecated `redefine`.++## 4.0.3++* Renamed `f.pi` into `pi`.++## 4.0.1++* Fixed a bug of not-patterns inside sequential patterns.+* Deprecated `procedure` (replace them with anonymous function)++## 4.0.0++* Enabled the Haskell-like new syntax by default.
+ README.md view
@@ -0,0 +1,359 @@+# The Egison Programming Language+[](https://travis-ci.org/egison/egison)++Egison is a functional programming language featuring its expressive pattern-matching facility.+Egison allows users to define efficient and expressive pattern-matching methods for arbitrary user-defined data types including non-free data types such as lists, multisets, sets, trees, graphs, and mathematical expressions.+This is the repository of the interpreter of Egison.++For more information, visit <a target="_blank" href="https://www.egison.org">our website</a>.++## Refereed Papers++### Pattern Matching++* Satoshi Egi, Yuichi Nishiwaki: [Non-linear Pattern Matching with Backtracking for Non-free Data Types](https://arxiv.org/abs/1808.10603) (APLAS 2018)+* Satoshi Egi, Yuichi Nishiwaki: [Functional Programming in Pattern-Match-Oriented Programming Style](https://doi.org/10.22152/programming-journal.org/2020/4/7) (<programming> 2020)++### Tensor Index Notation++* Satoshi Egi: [Scalar and Tensor Parameters for Importing Tensor Index Notation including Einstein Summation Notation](https://arxiv.org/abs/1702.06343) (Scheme Workshop 2017)++## Non-Linear Pattern Matching for Non-Free Data Types++We can use non-linear pattern matching for non-free data types in Egison.+A non-free data type is a data type whose data have no canonical form, or a standard way to represent that object.+For example, multisets are non-free data types because a multiset {a,b,b} has two other syntastically different representations: {b,a,b} and {b,b,a}.+Expressive pattern matching for these data types enables us to write elegant programs.++### Twin Primes++We can use pattern matching for enumeration.+The following code enumerates all twin primes from the infinite list of prime numbers with pattern matching!++```hs+def twinPrimes :=+ matchAll primes as list integer with+ | _ ++ $p :: #(p + 2) :: _ -> (p, p + 2)++take 8 twinPrimes+-- [(3, 5), (5, 7), (11, 13), (17, 19), (29, 31), (41, 43), (59, 61), (71, 73)]+```++### Poker Hands++The following code is a program that determines poker-hands written in Egison.+All hands are expressed in a single pattern.++```hs+def poker cs :=+ match cs as multiset card with+ | card $s $n :: card #s #(n-1) :: card #s #(n-2) :: card #s #(n-3) :: card #s #(n-4) :: _+ -> "Straight flush"+ | card _ $n :: card _ #n :: card _ #n :: card _ #n :: _ :: []+ -> "Four of a kind"+ | card _ $m :: card _ #m :: card _ #m :: card _ $n :: card _ #n :: []+ -> "Full house"+ | card $s _ :: card #s _ :: card #s _ :: card #s _ :: card #s _ :: []+ -> "Flush"+ | card _ $n :: card _ #(n-1) :: card _ #(n-2) :: card _ #(n-3) :: card _ #(n-4) :: []+ -> "Straight"+ | card _ $n :: card _ #n :: card _ #n :: _ :: _ :: []+ -> "Three of a kind"+ | card _ $m :: card _ #m :: card _ $n :: card _ #n :: _ :: []+ -> "Two pair"+ | card _ $n :: card _ #n :: _ :: _ :: _ :: []+ -> "One pair"+ | _ :: _ :: _ :: _ :: _ :: [] -> "Nothing"+```++### Graphs++We can pattern-match against graphs.+We can write a program to solve the travelling salesman problem in a single pattern-matching expression.++```hs+def graph := multiset (string, multiset (string, integer))++def graphData :=+ [("Berlin", [("New York", 14), ("London", 2), ("Tokyo", 14), ("Vancouver", 13)]),+ ("New York", [("Berlin", 14), ("London", 12), ("Tokyo", 18), ("Vancouver", 6)]),+ ("London", [("Berlin", 2), ("New York", 12), ("Tokyo", 15), ("Vancouver", 10)]),+ ("Tokyo", [("Berlin", 14), ("New York", 18), ("London", 15), ("Vancouver", 12)]),+ ("Vancouver", [("Berlin", 13), ("New York", 6), ("London", 10), ("Tokyo", 12)])]++def trips :=+ let n := length graphData in+ matchAll graphData as graph with+ | (#"Berlin", (($s_1,$p_1) : _)) ::+ loop $i (2, n - 1)+ ((#s_(i - 1), ($s_i, $p_i) :: _) :: ...)+ ((#s_(n - 1), (#"Berlin" & $s_n, $p_n) :: _) :: [])+ -> sum (map (\i -> p_i) [1..n]), map (\i -> s_i) [1..n]++car (sortBy (\(_, x), (_, y) -> compare x y)) trips)+-- (["London", "New York", "Vancouver", "Tokyo"," Berlin"], 46)+```++## Egison as a Computer Algebra System++As an application of Egison pattern matching, we have implemented a computer algebra system on Egison.+The most part of this computer algebra system is written in Egison and extensible using Egison.++### Symbolic Algebra++Egison treats unbound variables as symbols.++```+> x+x+> (x + y)^2+x^2 + 2 * x * y + y^2+> (x + y)^4+x^4 + 4 * x^3 * y + 6 * x^2 * y^2 + 4 * x * y^3 + y^4+```++We can handle algebraic numbers, too.++* [Definition of `sqrt` in `root.egi`](https://github.com/egison/egison/blob/master/lib/math/algebra/root.egi)++```+> sqrt x+sqrt x+> sqrt 2+sqrt 2+> x + sqrt y+x + sqrt y+```++### Complex Numbers++The symbol `i` is defined to rewrite `i^2` to `-1` in Egison library.++* [Rewriting rule for `i` in `normalize.egi`](https://github.com/egison/egison/blob/master/lib/math/normalize.egi)++```+> i * i+-1+> (1 + i) * (1 + i)+2 * i+> (x + y * i) * (x + y * i)+x^2 + 2 * x * y * i - y^2+```++### Square Root++The rewriting rule for `sqrt` is also defined in Egison library.++* [Rewriting rule for `sqrt` in `normalize.egi`](https://github.com/egison/egison/blob/master/lib/math/normalize.egi)++```+> sqrt 2 * sqrt 2+2+> sqrt 6 * sqrt 10+2 * sqrt 15+> sqrt (x * y) * sqrt (2 * x)+x * sqrt 2 * sqrt y+```++### The 5th Roots of Unity++The following is a sample to calculate the 5th roots of unity.++* [Definition of `q-f'` in `equations.egi`](https://github.com/egison/egison/blob/master/lib/math/algebra/equations.egi)++```+> qF' 1 1 (-1)+((-1 + sqrt 5) / 2, (-1 - sqrt 5) / 2)+> def t := fst (qF' 1 1 (-1))+> qF' 1 (-t) 1+((-1 + sqrt 5 + sqrt 2 * sqrt (-5 - sqrt 5)) / 4, (-1 + sqrt 5 - sqrt 2 * sqrt (-5 - sqrt 5)) / 4)+> def z := fst (qF' 1 (-t) 1)+> z+(-1 + sqrt 5 + sqrt 2 * sqrt (-5 - sqrt 5)) / 4+> z ^ 5+1+```++### Differentiation++We can implement differentiation easily in Egison.++* [Definition of `d/d` in `derivative.egi`](https://github.com/egison/egison/blob/master/lib/math/analysis/derivative.egi)++```+> d/d (x ^ 3) x+3 * x^2+> d/d (e ^ (i * x)) x+exp (x * i) * i+> d/d (d/d (log x) x) x+-1 / x^2+> d/d (cos x * sin x) x+-2 * (sin x)^2 + 1+```++### Taylor Expansion++The following sample executes Taylor expansion on Egison.+We verify [Euler's formula](https://en.wikipedia.org/wiki/Euler%27s_formula) in the following sample.++* [Definition of `taylor-expansion` in `derivative.egi`](https://github.com/egison/egison/blob/master/lib/math/analysis/derivative.egi)++```+> take 8 (taylorExpansion (exp (i * x)) x 0)+[1, x * i, - x^2 / 2, - x^3 * i / 6, x^4 / 24, x^5 * i / 120, - x^6 / 720, - x^7 * i / 5040]+> take 8 (taylorExpansion (cos x) x 0)+[1, 0, - x^2 / 2, 0, x^4 / 24, 0, - x^6 / 720, 0]+> take 8 (taylorExpansion (i * sin x) x 0)+[0, x * i, 0, - x^3 * i / 6, 0, x^5 * i / 120, 0, - x^7 * i / 5040]+> take 8 (map2 (+) (taylorExpansion (cos x) x 0) (taylorExpansion (i * sin x) x 0))+[1, x * i, - x^2 / 2, - x^3 * i / 6, x^4 / 24, x^5 * i / 120, - x^6 / 720, - x^7 * i / 5040]+```++### Tensor Index Notation++Egison supports tesnsor index notation.+We can use [Einstein notation](https://en.wikipedia.org/wiki/Einstein_notation) to express arithmetic operations between tensors.++The method for importing tensor index notation into programming is discussed in [Egison tensor paper](https://arxiv.org/abs/1702.06343).++The following sample is from [Riemann Curvature Tensor of S2 - Egison Mathematics Notebook](https://www.egison.org/math/riemann-curvature-tensor-of-S2.html).+++```hs+-- Parameters+def x := [| θ, φ |]++def X := [| r * (sin θ) * (cos φ) -- x+ , r * (sin θ) * (sin φ) -- y+ , r * (cos θ) -- z+ |]++def e_i_j := (∂/∂ X_j x~i)++-- Metric tensors+def g_i_j := generateTensor (\x y -> V.* e_x_# e_y_#) [2, 2]+def g~i~j := M.inverse g_#_#++g_#_# -- [| [| r^2, 0 |], [| 0, r^2 * (sin θ)^2 |] |]_#_#+g~#~# -- [| [| 1 / r^2, 0 |], [| 0, 1 / (r^2 * (sin θ)^2) |] |]~#~#++-- Christoffel symbols+def Γ_i_j_k := (1 / 2) * (∂/∂ g_i_k x~j + ∂/∂ g_i_j x~k - ∂/∂ g_j_k x~i)++Γ_1_#_# -- [| [| 0, 0 |], [| 0, -1 * r^2 * (sin θ) * (cos θ) |] |]_#_#+Γ_2_#_# -- [| [| 0, r^2 * (sin θ) * (cos θ) |], [| r^2 * (sin θ) * (cos θ), 0 |] |]_#_#++def Γ~i_j_k := withSymbols [m]+ g~i~m . Γ_m_j_k++Γ~1_#_# -- [| [| 0, 0 |], [| 0, -1 * (sin θ) * (cos θ) |] |]_#_#+Γ~2_#_# -- [| [| 0, (cos θ) / (sin θ) |], [| (cos θ) / (sin θ), 0 |] |]_#_#++-- Riemann curvature+def R~i_j_k_l := withSymbols [m]+ ∂/∂ Γ~i_j_l x~k - ∂/∂ Γ~i_j_k x~l + Γ~m_j_l . Γ~i_m_k - Γ~m_j_k . Γ~i_m_l++R~#_#_1_1 -- [| [| 0, 0 |], [| 0, 0 |] |]~#_#+R~#_#_1_2 -- [| [| 0, (sin θ)^2 |], [| -1, 0 |] |]~#_#+R~#_#_2_1 -- [| [| 0, -1 * (sin θ)^2 |], [| 1, 0 |] |]~#_#+R~#_#_2_2 -- [| [| 0, 0 |], [| 0, 0 |] |]~#_#+```++### Differential Forms++By designing the index completion rules for omitted indices, we can use the above notation to express a calculation handling the differential forms.++The following sample is from [Curvature Form - Egison Mathematics Notebook](https://www.egison.org/math/curvature-form.html).++```hs+-- Parameters and metric tensor+def x := [| θ, φ |]++def g_i_j := [| [| r^2, 0 |], [| 0, r^2 * (sin θ)^2 |] |]_i_j+def g~i~j := [| [| 1 / r^2, 0 |], [| 0, 1 / (r^2 * (sin θ)^2) |] |]~i~j++-- Christoffel symbols+def Γ_j_l_k := (1 / 2) * (∂/∂ g_j_l x~k + ∂/∂ g_j_k x~l - ∂/∂ g_k_l x~j)++def Γ~i_k_l := withSymbols [j] g~i~j . Γ_j_l_k++-- Exterior derivative+def d %t := !(flip ∂/∂) x t++-- Wedge product+infixl expression 7 ∧++def (∧) %x %y := x !. y++-- Connection form+def ω~i_j := Γ~i_j_#++-- Curvature form+def Ω~i_j := withSymbols [k]+ antisymmetrize (d ω~i_j + ω~i_k ∧ ω~k_j)++Ω~#_#_1_1 -- [| [| 0, 0 |], [| 0, 0 |] |]~#_#+Ω~#_#_1_2 -- [| [| 0, (sin θ)^2 / 2|], [| -1 / 2, 0 |] |]~#_#+Ω~#_#_2_1 -- [| [| 0, -1 * (sin θ)^2 / 2 |], [| 1 / 2, 0 |] |]~#_#+Ω~#_#_2_2 -- [| [| 0, 0 |], [| 0, 0 |] |]~#_#++```++### Egison Mathematics Notebook++Here are more samples.++* [Egison Mathematics Notebook](https://www.egison.org/math/)++## Comparison with Related Work++There are <a target="_blank" href="https://ghc.haskell.org/trac/ghc/wiki/ViewPatterns#Relatedwork">a lot of existing work</a> for pattern matching.++The advantage of Egison is that it fulfills the following two requirements at the same time.++1. Efficient backtracking algorithm for non-linear pattern matching.+2. Extensibility of patterns.++Additionally, it fulfills the following requirements.++3. Polymorphism of patterns.+4. Pattern matching with infinitely many results.++Check out <a target="_blank" href="https://arxiv.org/abs/1808.10603">our paper</a> for details.++## Installation++[Installation guide](https://egison.readthedocs.io/en/latest/reference/install.html) is available on our website.++If you are a beginner of Egison, it would be better to install <a target="_blank" href="https://github.com/egison/egison-tutorial">`egison-tutorial`</a> as well.++We also have [online interpreter](http://console.egison.org) and [online tutorial](http://try.egison.org/).+Enjoy!++## Notes for Developers++You can build Egison as follows:+```+$ stack init+$ stack build --fast+```++For testing, see [test/README.md](test/README.md).++## Community++We have <a target="_blank" href="https://www.egison.org/community.html">a mailing list</a>.+Please join us!++We are on <a target="_blank" href="https://twitter.com/Egison_Lang">Twitter</a>.+Please follow us.++## License++Egison is released under the [MIT license](https://github.com/egison/egison/blob/master/LICENSE).++We used [husk-scheme](http://justinethier.github.io/husk-scheme/) by Justin Ethier as reference to implement the base part of the previous version of the interpreter.++## Sponsors++Egison is sponsored by [Rakuten, Inc.](http://global.rakuten.com/corp/) and [Rakuten Institute of Technology](http://rit.rakuten.co.jp/).
benchmark/Benchmark.hs view
@@ -1,22 +1,30 @@ module Main where +import Control.Monad.Trans.Class (lift) import Criterion import Criterion.Main+ import Language.Egison -runEgisonFile :: String -> IO ()-runEgisonFile path = evalRuntimeT defaultOption $ do- env <- initialEnv- _ <- loadEgisonFile env path- return ()+runEgisonFile :: FilePath -> IO Env+runEgisonFile path = do+ res <- fromEvalM defaultOption $ do+ env <- lift (lift initialEnv)+ topExprs <- loadFile path+ evalTopExprsNoPrint env topExprs+ case res of+ Left err -> do+ print err+ return nullEnv+ Right env -> return env main :: IO () main = defaultMainWith defaultConfig [ bgroup "fact"- [ bench "30000" $ nfIO $ runEgisonFile "benchmark/fact-30000.egi" ]+ [ bench "30000" $ whnfIO $ runEgisonFile "benchmark/fact-30000.egi" ] , bgroup "collection"- [ bench "cons-bench" $ nfIO $ runEgisonFile "benchmark/collection-bench-cons.egi"- , bench "cons-bench-large" $ nfIO $ runEgisonFile "benchmark/collection-bench-cons-large.egi"- , bench "snoc-bench" $ nfIO $ runEgisonFile "benchmark/collection-bench-snoc.egi"- ]]-+ [ bench "cons-bench" $ whnfIO $ runEgisonFile "benchmark/collection-bench-cons.egi"+ , bench "cons-bench-large" $ whnfIO $ runEgisonFile "benchmark/collection-bench-cons-large.egi"+ , bench "snoc-bench" $ whnfIO $ runEgisonFile "benchmark/collection-bench-snoc.egi"+ ]+ ]
+ benchmark/collection-bench-cons-large.egi view
@@ -0,0 +1,11 @@+def countEvens n l :=+ match l as list integer with+ | ?isEven :: $tl -> countEvens (n + 1) tl+ | _ :: $tl -> countEvens n tl+ | [] -> n++def testNumbers :=+ let from n := if n <= 0 then [0] else n :: from (n - 1)+ in from 100000++countEvens 0 testNumbers
+ benchmark/collection-bench-cons.egi view
@@ -0,0 +1,11 @@+def countEvens n l :=+ match l as list integer with+ | ?isEven :: $tl -> countEvens (n + 1) tl+ | _ :: $tl -> countEvens n tl+ | [] -> n++def testNumbers :=+ let from n := if n <= 0 then [0] else n :: from (n - 1)+ in from 10000++countEvens 0 testNumbers
+ benchmark/collection-bench-snoc.egi view
@@ -0,0 +1,11 @@+def countEvens n l :=+ match l as list integer with+ | snoc ?isEven $tl -> countEvens (n + 1) tl+ | snoc _ $tl -> countEvens n tl+ | [] -> n++def testNumbers :=+ let from n := if n <= 0 then [0] else n :: from (n - 1)+ in from 10000++countEvens 0 testNumbers
+ benchmark/fact-30000.egi view
@@ -0,0 +1,6 @@+def fact :=+ \match as integer with+ | #1 -> 1+ | $x -> x * fact (x - 1)++fact 30000
+ benchmark/prime-pairs-2.egi view
@@ -0,0 +1,53 @@+def n := 100++def primes :=+ [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71,+ 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151,+ 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233,+ 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, 307, 311, 313, 317,+ 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397, 401, 409, 419,+ 421, 431, 433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503,+ 509, 521, 523, 541, 547, 557, 563, 569, 571, 577, 587, 593, 599, 601, 607,+ 613, 617, 619, 631, 641, 643, 647, 653, 659, 661, 673, 677, 683, 691, 701,+ 709, 719, 727, 733, 739, 743, 751, 757, 761, 769, 773, 787, 797, 809, 811,+ 821, 823, 827, 829, 839, 853, 857, 859, 863, 877, 881, 883, 887, 907, 911,+ 919, 929, 937, 941, 947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013, 1019,+ 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, 1087, 1091, 1093, 1097,+ 1103, 1109, 1117, 1123, 1129, 1151, 1153, 1163, 1171, 1181, 1187, 1193, 1201,+ 1213, 1217, 1223, 1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291,+ 1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, 1381, 1399, 1409,+ 1423, 1427, 1429, 1433, 1439, 1447, 1451, 1453, 1459, 1471, 1481, 1483, 1487,+ 1489, 1493, 1499, 1511, 1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579,+ 1583, 1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, 1663, 1667,+ 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733, 1741, 1747, 1753, 1759, 1777,+ 1783, 1787, 1789, 1801, 1811, 1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877,+ 1879, 1889, 1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987, 1993,+ 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, 2063, 2069, 2081, 2083,+ 2087, 2089, 2099, 2111, 2113, 2129, 2131, 2137, 2141, 2143, 2153, 2161, 2179,+ 2203, 2207, 2213, 2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287,+ 2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357, 2371, 2377, 2381,+ 2383, 2389, 2393, 2399, 2411, 2417, 2423, 2437, 2441, 2447, 2459, 2467, 2473,+ 2477, 2503, 2521, 2531, 2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609,+ 2617, 2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687, 2689, 2693,+ 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741, 2749, 2753, 2767, 2777, 2789,+ 2791, 2797, 2801, 2803, 2819, 2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887,+ 2897, 2903, 2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999, 3001,+ 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079, 3083, 3089, 3109, 3119,+ 3121, 3137, 3163, 3167, 3169, 3181, 3187, 3191, 3203, 3209, 3217, 3221, 3229,+ 3251, 3253, 3257, 3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331,+ 3343, 3347, 3359, 3361, 3371, 3373, 3389, 3391, 3407, 3413, 3433, 3449, 3457,+ 3461, 3463, 3467, 3469, 3491, 3499, 3511, 3517, 3527, 3529, 3533, 3539, 3541,+ 3547, 3557, 3559, 3571, 3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637,+ 3643, 3659, 3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727, 3733, 3739,+ 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821, 3823, 3833, 3847, 3851, 3853,+ 3863, 3877, 3881, 3889, 3907, 3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947,+ 3967, 3989, 4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057, 4073,+ 4079, 4091, 4093, 4099, 4111, 4127, 4129, 4133, 4139, 4153, 4157, 4159, 4177,+ 4201, 4211, 4217, 4219, 4229, 4231, 4241, 4243, 4253, 4259, 4261, 4271, 4273,+ 4283, 4289, 4297, 4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409]++def twinPrimes :=+ matchAll primes as list integer with+ | _ ++ $p :: #(p + 2) :: _ -> (p, p + 2)++take n twinPrimes
+ benchmark/prime-pairs-6.egi view
@@ -0,0 +1,53 @@+def n := 10++def primes :=+ [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71,+ 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151,+ 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233,+ 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, 307, 311, 313, 317,+ 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397, 401, 409, 419,+ 421, 431, 433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503,+ 509, 521, 523, 541, 547, 557, 563, 569, 571, 577, 587, 593, 599, 601, 607,+ 613, 617, 619, 631, 641, 643, 647, 653, 659, 661, 673, 677, 683, 691, 701,+ 709, 719, 727, 733, 739, 743, 751, 757, 761, 769, 773, 787, 797, 809, 811,+ 821, 823, 827, 829, 839, 853, 857, 859, 863, 877, 881, 883, 887, 907, 911,+ 919, 929, 937, 941, 947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013, 1019,+ 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, 1087, 1091, 1093, 1097,+ 1103, 1109, 1117, 1123, 1129, 1151, 1153, 1163, 1171, 1181, 1187, 1193, 1201,+ 1213, 1217, 1223, 1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291,+ 1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, 1381, 1399, 1409,+ 1423, 1427, 1429, 1433, 1439, 1447, 1451, 1453, 1459, 1471, 1481, 1483, 1487,+ 1489, 1493, 1499, 1511, 1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579,+ 1583, 1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, 1663, 1667,+ 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733, 1741, 1747, 1753, 1759, 1777,+ 1783, 1787, 1789, 1801, 1811, 1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877,+ 1879, 1889, 1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987, 1993,+ 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, 2063, 2069, 2081, 2083,+ 2087, 2089, 2099, 2111, 2113, 2129, 2131, 2137, 2141, 2143, 2153, 2161, 2179,+ 2203, 2207, 2213, 2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287,+ 2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357, 2371, 2377, 2381,+ 2383, 2389, 2393, 2399, 2411, 2417, 2423, 2437, 2441, 2447, 2459, 2467, 2473,+ 2477, 2503, 2521, 2531, 2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609,+ 2617, 2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687, 2689, 2693,+ 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741, 2749, 2753, 2767, 2777, 2789,+ 2791, 2797, 2801, 2803, 2819, 2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887,+ 2897, 2903, 2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999, 3001,+ 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079, 3083, 3089, 3109, 3119,+ 3121, 3137, 3163, 3167, 3169, 3181, 3187, 3191, 3203, 3209, 3217, 3221, 3229,+ 3251, 3253, 3257, 3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331,+ 3343, 3347, 3359, 3361, 3371, 3373, 3389, 3391, 3407, 3413, 3433, 3449, 3457,+ 3461, 3463, 3467, 3469, 3491, 3499, 3511, 3517, 3527, 3529, 3533, 3539, 3541,+ 3547, 3557, 3559, 3571, 3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637,+ 3643, 3659, 3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727, 3733, 3739,+ 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821, 3823, 3833, 3847, 3851, 3853,+ 3863, 3877, 3881, 3889, 3907, 3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947,+ 3967, 3989, 4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057, 4073,+ 4079, 4091, 4093, 4099, 4111, 4127, 4129, 4133, 4139, 4153, 4157, 4159, 4177,+ 4201, 4211, 4217, 4219, 4229, 4231, 4241, 4243, 4253, 4259, 4261, 4271, 4273,+ 4283, 4289, 4297, 4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409]++def primeTriplets :=+ matchAll primes as list integer with+ | _ ++ $p :: ($m & (#(p + 2) | #(p + 4))) :: #(p + 6) :: _ -> (p, m, p + 6)++take n primeTriplets
egison.cabal view
@@ -1,5 +1,5 @@ Name: egison-Version: 4.1.1+Version: 4.1.2 Synopsis: Programming language with non-linear pattern-matching against non-free data Description: An interpreter for Egison, a **pattern-matching-oriented**, purely functional programming language.@@ -57,15 +57,26 @@ Build-type: Simple Cabal-version: 2.0 -Extra-Source-Files: benchmark/Benchmark.hs+Data-files: lib/core/*.egi+ lib/math/*.egi+ lib/math/common/*.egi+ lib/math/algebra/*.egi+ lib/math/analysis/*.egi+ lib/math/geometry/*.egi -Data-files: lib/core/shell.egi- lib/core/*.egi lib/math/*.egi lib/math/common/*.egi lib/math/algebra/*.egi lib/math/analysis/*.egi lib/math/geometry/*.egi- sample/*.egi sample/sat/*.egi sample/math/geometry/*.egi sample/math/number/*.egi- test/*.egi test/lib/core/*.egi test/lib/math/*.egi+Extra-source-files: README.md+ Changelog.md+ benchmark/Benchmark.hs+ benchmark/*.egi+ test/fixture/*.egi+ test/lib/math/*.egi+ test/lib/core/*.egi+ sample/*.egi+ sample/sat/*.egi+ sample/math/geometry/*.egi+ sample/math/number/*.egi elisp/egison-mode.el - source-repository head type: git location: https://github.com/egison/egison.git@@ -96,7 +107,7 @@ , optparse-applicative , prettyprinter , unicode-show- , sweet-egison >= 0.1.1.2+ , sweet-egison >= 0.1.1.3 if !impl(ghc > 8.0) Build-Depends: fail Hs-Source-Dirs: hs-src@@ -161,6 +172,22 @@ autogen-modules: Paths_egison ghc-options: -Wall -Wno-name-shadowing +Test-Suite test-cli+ default-language: Haskell2010+ Type: exitcode-stdio-1.0+ Hs-Source-Dirs: test+ Main-Is: OptionsTest.hs+ Build-Depends:+ egison+ , base >= 4.0 && < 5+ , process+ , HUnit+ , test-framework+ , test-framework-hunit+ Other-modules: Paths_egison+ autogen-modules: Paths_egison+ ghc-options: -Wall -Wno-name-shadowing+ Benchmark benchmark default-language: Haskell2010 Type: exitcode-stdio-1.0@@ -170,6 +197,7 @@ egison , base >= 4.0 && < 5 , criterion >= 0.5+ , transformers Other-modules: Paths_egison autogen-modules: Paths_egison ghc-options: -Wall -Wno-name-shadowing
hs-src/Interpreter/egison.hs view
@@ -2,28 +2,27 @@ module Main where -import Control.Exception (AsyncException (..))-import Control.Monad.Catch (catch)+import Control.Exception (AsyncException (..))+import Control.Monad.Catch (catch) import Control.Monad.Except import Control.Monad.Reader -import Data.List (intercalate)-import qualified Data.Text as T+import Data.List (intercalate)+import qualified Data.Text as T import Data.Version -import System.Console.Haskeline hiding (catch, handle, throwTo)+import System.Console.Haskeline (InputT, getInputLine, getHistory, putHistory,+ runInputT, Settings (..)) import System.Console.Haskeline.History (addHistoryUnlessConsecutiveDupe)-import System.Directory (getHomeDirectory)-import System.Exit (exitFailure, exitSuccess)-import System.FilePath ((</>))+import System.Directory (getHomeDirectory)+import System.Exit (exitFailure, exitSuccess)+import System.FilePath ((</>)) import System.IO-import Text.Regex.TDFA ((=~))+import Text.Regex.TDFA ((=~)) import Language.Egison import Language.Egison.Completion-import Language.Egison.Eval-import Language.Egison.Parser (parseTopExpr) import Options.Applicative @@ -78,7 +77,7 @@ liftIO $ either print (const $ return ()) result -- Execute a script from the main function EgisonOpts { optExecFile = Just (file, args) } -> do- result <- fromEvalT $ evalTopExprs env [LoadFile file, Execute (makeApply "main" (map (ConstantExpr . StringExpr . T.pack) args))]+ result <- fromEvalT $ evalTopExprs env [LoadFile file, Execute (makeApply "main" [CollectionExpr (map (ConstantExpr . StringExpr . T.pack) args)])] liftIO $ either print (const $ return ()) result EgisonOpts { optMapTsvInput = Just expr } -> handleOption env (opts { optSubstituteString = Just $ "\\x -> map (" ++ expr ++ ") x" })@@ -119,7 +118,11 @@ showByebyeMessage = putStrLn "Leaving Egison Interpreter." settings :: MonadIO m => FilePath -> Env -> Settings m-settings home env = setComplete (completeEgison env) $ defaultSettings { historyFile = Just (home </> ".egison_history"), autoAddHistory = False }+settings home env =+ Settings { complete = completeEgison env+ , historyFile = Just (home </> ".egison_history")+ , autoAddHistory = False+ } repl :: Env -> RuntimeM () repl env = (do
hs-src/Language/Egison.hs view
@@ -8,6 +8,8 @@ module Language.Egison ( module Language.Egison.AST , module Language.Egison.Data+ , module Language.Egison.Eval+ , module Language.Egison.Parser , module Language.Egison.Primitives -- * Modules needed to execute Egison , module Language.Egison.CmdOptions@@ -28,6 +30,7 @@ import Language.Egison.CmdOptions import Language.Egison.Data import Language.Egison.Eval+import Language.Egison.Parser import Language.Egison.Primitives import Language.Egison.RState
hs-src/Language/Egison/CmdOptions.hs view
@@ -11,9 +11,11 @@ , cmdParser ) where -import Data.Char (isDigit)+import Data.Functor (($>)) import Data.List (intercalate)+import Data.Maybe (maybeToList) import Options.Applicative+import qualified Text.Parsec as P data EgisonOpts = EgisonOpts { optExecFile :: Maybe (String, [String]),@@ -61,7 +63,7 @@ <> long "command" <> metavar "EXPR" <> help "Execute the argument string"))- <*> many (readFieldOption <$> strOption+ <*> many (option readFieldOption (short 'F' <> long "field" <> metavar "FIELD"@@ -124,21 +126,22 @@ (long "no-normalize" <> help "Turn off normalization of math expressions") -readFieldOption :: String -> (String, String)-readFieldOption str =- let (s, c) = readFieldOption' str in (f s, f c)- where- f x = "[" ++ intercalate ", " x ++ "]"- readFieldOption' str =- let (s, rs) = span isDigit str in- case rs of- ',':rs' -> let (e, opts) = span isDigit rs' in- case opts of- ['s'] -> ([s, e], [])- ['c'] -> ([], [s, e])- ['s', 'c'] -> ([s, e], [s, e])- ['c', 's'] -> ([s, e], [s, e])- ['s'] -> ([s], [])- ['c'] -> ([], [s])- ['s', 'c'] -> ([s], [s])- ['c', 's'] -> ([s], [s])+readFieldOption :: ReadM (String, String)+readFieldOption = eitherReader $ \str ->+ case P.parse parseFieldOption "(argument)" str of+ Left err -> Left $ show err+ Right ok -> Right ok++parseFieldOption :: P.Parsec String () (String, String)+parseFieldOption = do+ s <- P.many1 P.digit+ e <- P.optionMaybe (P.char ',' >> P.many1 P.digit)+ let se = s : maybeToList e+ (rs, rc)+ <- P.try (P.string "sc") $> (se, se)+ <|> P.try (P.string "cs") $> (se, se)+ <|> P.try (P.string "s" ) $> (se, [])+ <|> P.try (P.string "c" ) $> ([], se)+ P.eof+ let f x = "[" ++ intercalate ", " x ++ "]"+ return (f rs, f rc)
hs-src/Language/Egison/Completion.hs view
@@ -9,9 +9,9 @@ ( completeEgison ) where -import Data.HashMap.Strict (keys)+import Data.HashMap.Strict (keys) import Data.List-import System.Console.Haskeline hiding (catch, handle, throwTo)+import System.Console.Haskeline (Completion (..), CompletionFunc, completeWord) import Language.Egison.Data (Env (..)) import Language.Egison.IExpr (Var (..))
hs-src/Language/Egison/Core.hs view
@@ -11,8 +11,9 @@ -} module Language.Egison.Core- -- * Egison code evaluation- ( evalExprShallow+ (+ -- * Evaluation+ evalExprShallow , evalExprDeep , evalWHNF -- * Environment@@ -675,7 +676,7 @@ thunk <- newThunkRef env'' expr binds <- bindPrimitiveDataPattern pd thunk forM_ binds $ \(var, objref) -> do- -- |obj| is an Object being bound to |var|.+ -- Get an Object |obj| being bound to |var|. obj <- liftIO $ readIORef objref let ref = fromJust (refVar env' var) liftIO $ writeIORef ref obj
hs-src/Language/Egison/Eval.hs view
@@ -6,8 +6,9 @@ -} module Language.Egison.Eval+ ( -- * Eval Egison expressions- ( evalExpr+ evalExpr , evalTopExpr , evalTopExprStr , evalTopExprs
+ test/OptionsTest.hs view
@@ -0,0 +1,84 @@+module Main (main) where++import Data.Version (showVersion)+import System.Process (readProcess)++import Test.Framework (defaultMain)+import Test.Framework.Providers.HUnit (hUnitTestToTests)+import Test.HUnit++import Language.Egison (version)++main :: IO ()+main = defaultMain . hUnitTestToTests . test $ TestList+ [ TestLabel "load-file option" . TestCase $ assertEgisonCmd+ (interpreter "1\n")+ ["--load-file", "test/fixture/a.egi"]+ "x"+ , TestLabel "test option" . TestCase $ assertEgisonCmd+ "3\n\"This is the third line\"\n"+ ["--test", "test/fixture/b.egi"]+ ""+ , TestLabel "eval option" . TestCase $ assertEgisonCmd+ "[[], [1], [1, 2], [1, 2, 3]]\n"+ ["--eval", "matchAll [1,2,3] as list something with $x ++ _ -> x"]+ ""+ , TestLabel "command option" . TestCase $ assertEgisonCmd+ "1\n"+ ["--command", "print (show 1)"]+ ""+ , TestLabel "TSV option" . TestCase $ assertEgisonCmd+ "2\n3\n5\n7\n11\n13\n17\n19\n23\n29\n"+ ["-T", "-e", "take 10 primes"]+ ""+ , TestLabel "TSV option with tab" . TestCase $ assertEgisonCmd+ "1\t2\t3\n4\t5\n"+ ["-T", "-e", "[[1, 2, 3], [4, 5]]"]+ ""+ , TestLabel "substitute option" . TestCase $ assertEgisonCmd+ "10\n11\n12\n13\n14\n15\n"+ ["--substitute", "\\matchAll as list integer with _ ++ $x :: _ ++ #(x + 5) :: _ -> x"]+ "10\n11\n12\n13\n14\n15\n16\n17\n18\n19\n20"+ , TestLabel "map option" . TestCase $ assertEgisonCmd+ "3\n4\n5\n6\n7\n"+ ["--map", "\\x -> x + 2"]+ "1\n2\n3\n4\n5"+ , TestLabel "filter option" . TestCase $ assertEgisonCmd+ "2\n3\n5\n7\n"+ ["--filter", "isPrime"]+ "1\n2\n3\n4\n5\n6\n7\n8\n9\n10"+ , TestLabel "field option" . TestCase $ assertEgisonCmd+ "(10, [2, 5])\n(11, [11])\n(12, [2, 2, 3])\n(13, [13])\n(14, [2, 7])\n(15, [3, 5])\n"+ ["--field", "2c", "-m", "\\x -> x"]+ "10\t2\t5\n11\t11\n12\t2\t2\t3\n13\t13\n14\t2\t7\n15\t3\t5"+ , TestLabel "math option" . TestCase $ assertEgisonCmd+ (interpreter "#latex|\\frac{x}{y}|#\n")+ ["--math", "latex"]+ "x / y"+ , TestLabel "sexpr option" . TestCase $ assertEgisonCmd+ (interpreter "3\n")+ ["--sexpr-syntax"]+ "(+ 1 2)"+ , TestLabel "execute main function" . TestCase $ assertEgisonCmd+ "[\"a\", \"b\", \"c\"]\n"+ ["test/fixture/c.egi", "a", "b", "c"]+ ""+ ]++assertEgisonCmd+ :: String -- The expected value+ -> [String] -- any arguments for egison command+ -> String -- standard input for egison command+ -> Assertion+assertEgisonCmd expected args input = do+ actual <- readProcess "stack" ("exec" : "--" : "egison" : args) input+ assertEqual "" expected actual++interpreter :: String -> String+interpreter output = concat+ [ "Egison Version ", showVersion version, "\n"+ , "https://www.egison.org\n"+ , "Welcome to Egison Interpreter!\n"+ , "> ", output+ , "> Leaving Egison Interpreter.\n"+ ]
test/Test.hs view
@@ -1,20 +1,20 @@ module Main where import Control.Monad.Trans.Class (lift)+import System.Environment (getArgs) -import Test.Framework (defaultMain)+import Test.Framework (defaultMainWithArgs) import Test.Framework.Providers.HUnit (hUnitTestToTests) import Test.HUnit import Language.Egison-import Language.Egison.Eval import Language.Egison.MathOutput-import Language.Egison.Parser main :: IO () main = do t <- evalRuntimeT defaultOption mathOutputTest- defaultMain . hUnitTestToTests . test $ t : map runTestCase testCases+ args <- getArgs+ flip defaultMainWithArgs args . hUnitTestToTests . test $ t : map runTestCase testCases testCases :: [FilePath] testCases =
− test/dp.egi
@@ -1,47 +0,0 @@-literal := integer--deleteLiteral l cnf :=- map (\matchAll as multiset integer with- | (!#l & $x) :: _ -> x)- cnf--deleteClausesWith l cnf :=- matchAll cnf as multiset (multiset integer) with- | (!(#l :: _) & $c) :: _ -> c--assignTrue l cnf :=- deleteLiteral (neg l) (deleteClausesWith l cnf)--resolveOn v cnf :=- matchAll cnf as multiset (multiset integer) with- | {(#v :: (@ & $xs)) :: (#(neg v) :: (@ & $ys)) :: _,- !($l :: _, #(neg l) :: _)}- -> unique (xs ++ ys)--dp vars cnf :=- match (vars, cnf) as (multiset literal, multiset (multiset literal)) with- -- satisfiable- | (_, []) -> True- -- unsatisfiable- | (_, [] :: _) -> False- -- 1-literal rule- | (_, (($l :: []) :: _))- -> dp (delete (abs l) vars) (assignTrue l cnf)- -- pure literal rule (positive)- | ($v :: $vs, !((#(neg v) :: _) :: _))- -> dp vs (assignTrue v cnf)- -- pure literal rule (negative)- | ($v :: $vs, !((#v :: _) :: _))- -> dp vs (assignTrue (neg v) cnf)- -- otherwise- | ($v :: $vs, _)- -> dp vs (resolveOn v cnf ++- deleteClausesWith v (deleteClausesWith (neg v) cnf))--assertEqual "dp" (dp [1] [[1]]) True-assertEqual "dp" (dp [1] [[1],[-1]]) False-assertEqual "dp" (dp [1,2,3] [[1,2],[-1,3],[1,-3]]) True-assertEqual "dp" (dp [1,2] [[1,2],[-1,-2],[1,-2]]) True-assertEqual "dp" (dp [1,2] [[1,2],[-1,-2],[1,-2],[-1,2]]) False-assertEqual "dp" (dp [1,2,3,4,5] [[-1,-2,3],[-1,-2,-3],[1,2,3,4],[-4,-2,3],[5,1,2,-3],[-3,1,-5],[1,-2,3,4],[1,-2,-3,5]]) True-assertEqual "dp" (dp [1,2] [[-1,-2],[1]]) True
+ test/fixture/a.egi view
@@ -0,0 +1,1 @@+def x := 1
+ test/fixture/b.egi view
@@ -0,0 +1,3 @@+def x := 1+x + 2+"This is the third line"
+ test/fixture/c.egi view
@@ -0,0 +1,2 @@+def main args :=+ print (show args)
− test/poker-joker.egi
@@ -1,37 +0,0 @@-suit := algebraicDataMatcher- | spade- | heart- | club- | diamond--card := matcher- | card $ $ as (suit, mod 13) with - | Card $s $n -> [(s, n)]- | Joker -> matchAll ([Spade, Heart, Club, Diamond], [1..13])- as (set suit, set integer) with- | ($s :: _, $n :: _) -> (s, n)- | $ as something with- | $tgt -> [tgt]--poker cs :=- match cs as multiset card with- | card $s $n :: card #s #(n-1) :: card #s #(n-2) :: card #s #(n-3) :: card #s #(n-4) :: _- -> "Straight flush"- | card _ $n :: card _ #n :: card _ #n :: card _ #n :: _ :: []- -> "Four of a kind"- | card _ $m :: card _ #m :: card _ #m :: card _ $n :: card _ #n :: []- -> "Full house"- | card $s _ :: card #s _ :: card #s _ :: card #s _ :: card #s _ :: []- -> "Flush"- | card _ $n :: card _ #(n-1) :: card _ #(n-2) :: card _ #(n-3) :: card _ #(n-4) :: []- -> "Straight"- | card _ $n :: card _ #n :: card _ #n :: _ :: _ :: []- -> "Three of a kind"- | card _ $m :: card _ #m :: card _ $n :: card _ #n :: _ :: []- -> "Two pair"- | card _ $n :: card _ #n :: _ :: _ :: _ :: []- -> "One pair"- | _ :: _ :: _ :: _ :: _ :: [] -> "Nothing"--assertEqual "poker-joker" (poker [Card Spade 5, Card Spade 6, Joker, Card Spade 8, Card Spade 9]) "Straight flush"-assertEqual "poker-joker" (poker [Card Spade 5, Card Diamond 5, Joker, Card Club 5, Card Heart 7]) "Four of a kind"
− test/poker.egi
@@ -1,39 +0,0 @@-suit := algebraicDataMatcher- | spade- | heart- | club- | diamond--card := algebraicDataMatcher- | card suit (mod 13)--poker cs :=- match cs as multiset card with- | card $s $n :: card #s #(n-1) :: card #s #(n-2) :: card #s #(n-3) :: card #s #(n-4) :: _- -> "Straight flush"- | card _ $n :: card _ #n :: card _ #n :: card _ #n :: _ :: []- -> "Four of a kind"- | card _ $m :: card _ #m :: card _ #m :: card _ $n :: card _ #n :: []- -> "Full house"- | card $s _ :: card #s _ :: card #s _ :: card #s _ :: card #s _ :: []- -> "Flush"- | card _ $n :: card _ #(n-1) :: card _ #(n-2) :: card _ #(n-3) :: card _ #(n-4) :: []- -> "Straight"- | card _ $n :: card _ #n :: card _ #n :: _ :: _ :: []- -> "Three of a kind"- | card _ $m :: card _ #m :: card _ $n :: card _ #n :: _ :: []- -> "Two pair"- | card _ $n :: card _ #n :: _ :: _ :: _ :: []- -> "One pair"- | _ :: _ :: _ :: _ :: _ :: [] -> "Nothing"---assertEqual "poker" (poker [Card Spade 5, Card Spade 6, Card Spade 7, Card Spade 8, Card Spade 9]) "Straight flush"-assertEqual "poker" (poker [Card Spade 5, Card Diamond 5, Card Spade 7, Card Club 5, Card Heart 5]) "Four of a kind"-assertEqual "poker" (poker [Card Spade 5, Card Diamond 5, Card Spade 7, Card Club 5, Card Heart 7]) "Full house"-assertEqual "poker" (poker [Card Spade 5, Card Spade 6, Card Spade 7, Card Spade 13, Card Spade 9]) "Flush"-assertEqual "poker" (poker [Card Spade 5, Card Club 6, Card Spade 7, Card Spade 8, Card Spade 9]) "Straight"-assertEqual "poker" (poker [Card Spade 5, Card Diamond 5, Card Spade 7, Card Club 5, Card Heart 8]) "Three of a kind"-assertEqual "poker" (poker [Card Spade 5, Card Diamond 10, Card Spade 7, Card Club 5, Card Heart 10]) "Two pair"-assertEqual "poker" (poker [Card Spade 5, Card Diamond 10, Card Spade 7, Card Club 5, Card Heart 8]) "One pair"-assertEqual "poker" (poker [Card Spade 5, Card Spade 6, Card Spade 7, Card Spade 8, Card Diamond 11]) "Nothing"
− test/primitive.egi
@@ -1,159 +0,0 @@-assertEqual "numerator" (numerator (13 / 21)) 13--assertEqual "denominator" (denominator (13 / 21)) 21--assertEqual "modulo" (modulo (-21) 13) 5--assertEqual "quotient" (quotient (-21) 13) (-1)--assertEqual "remainder" ((-21) % 13) (-8)--assertEqual "neg" (neg (-89)) 89--assertEqual "abs" (abs 0) 0-assertEqual "abs" (abs 15) 15-assertEqual "abs" (abs (-89)) 89--assertEqual "lt" (0.1 < 1.0) True-assertEqual "lt" (1.0 < 0.1) False-assertEqual "lt" (1.0 < 1.0) False--assertEqual "lte" (0.1 <= 1.0) True-assertEqual "lte" (1.0 <= 0.1) False-assertEqual "lte" (1.0 <= 1.0) True--assertEqual "gt" (0.1 > 1.0) False-assertEqual "gt" (1.0 > 0.1) True-assertEqual "gt" (1.0 > 1.0) False--assertEqual "gte" (0.1 >= 1.0) False-assertEqual "gte" (1.0 >= 0.1) True-assertEqual "gte" (1.0 >= 1.0) True--assertEqual "round" (round 3.1) 3-assertEqual "round" (round 3.7) 4-assertEqual "round" (round (-2.2)) (-2)-assertEqual "round" (round (-2.7)) (-3)--assertEqual "floor" (floor 3.1) 3-assertEqual "floor" (floor 3.7) 3-assertEqual "floor" (floor (-2.2)) (-3)-assertEqual "floor" (floor (-2.7)) (-3)--assertEqual "ceiling" (ceiling 3.1) 4-assertEqual "ceiling" (ceiling 3.7) 4-assertEqual "ceiling" (ceiling (-2.2)) (-2)-assertEqual "ceiling" (ceiling (-2.7)) (-2)--assertEqual "truncate" (truncate 3.1) 3-assertEqual "truncate" (truncate 3.7) 3-assertEqual "truncate" (truncate (-2.2)) (-2)-assertEqual "truncate" (truncate (-2.7)) (-2)--assertEqual "sqrt" (sqrt 4) 2-assertEqual "sqrt" (sqrt 4.0) 2.0-assertEqual "sqrt" (sqrt (-1)) i--assertEqual "exp" (exp 1) e-assertEqual "exp" (exp 1.0) 2.718281828459045-assertEqual "exp" (exp (-1.0)) 0.36787944117144233--assertEqual "log" (log e) 1-assertEqual "log" (log 10.0) 2.302585092994046--assertEqual "sin" (sin 0.0) 0.0-assertEqual "cos" (cos 0.0) 1.0-assertEqual "tan" (tan 0.0) 0.0-assertEqual "asin" (asin 0.0) 0.0-assertEqual "acos" (acos 1.0) 0.0-assertEqual "atan" (atan 0.0) 0.0-assertEqual "sinh" (sinh 0.0) 0.0-assertEqual "cosh" (cosh 0.0) 1.0-assertEqual "tanh" (tanh 0.0) 0.0-assertEqual "asinh" (asinh 0.0) 0.0-assertEqual "acosh" (acosh 1.0) 0.0-assertEqual "atanh" (atanh 0.0) 0.0---- tensorSize--- tensorToList--- dfOrder--assertEqual "itof" (itof 4) 4.0-assertEqual "itof" (itof (-1)) (-1.0)--assertEqual "rtof" (rtof (3 / 2)) 1.5-assertEqual "rtof" (rtof 1) 1.0--assertEqual "ctoi" (ctoi '1') 49--assertEqual "itoc" (itoc 49) '1'--assertEqual "pack" (pack []) ""-assertEqual "pack" (pack ['E', 'g', 'i', 's', 'o', 'n']) "Egison"--assertEqual "unpack" (unpack "Egison") ['E', 'g', 'i', 's', 'o', 'n']-assertEqual "unpack" (unpack "") []--assertEqual "unconsString" (unconsString "Egison") ('E', "gison")--assertEqual "lengthString" (lengthString "") 0-assertEqual "lengthString" (lengthString "Egison") 6--assertEqual "appendString" (appendString "" "") ""-assertEqual "appendString" (appendString "" "Egison") "Egison"-assertEqual "appendString" (appendString "Egison" "") "Egison"-assertEqual "appendString" (appendString "Egi" "son") "Egison"--assertEqual "splitString" (splitString "," "") [""]-assertEqual "splitString" (splitString "," "2,3,5,7,11,13") ["2", "3", "5", "7", "11", "13"]--assertEqual "regex" (regex "cde" "abcdefg") [("ab", "cde", "fg")]-assertEqual "regex" (regex "[0-9]+" "abc123defg") [("abc", "123", "defg")]-assertEqual "regex" (regex "a*" "") [("", "", "")]--assertEqual "regexCg" (regexCg "([0-9]+),([0-9]+)" "abc,123,45,defg") [("abc,", ["123", "45"], ",defg")]---- addSubscript--- addSuperscript--assertEqual "read" (read "3") 3-assertEqual "read" (read "3.14") 3.14-assertEqual "read" (read "[1, 2]") [1, 2]-assertEqual "read" (read "\"Hello world!\"") "Hello world!"---- TODO: read-tsv--assertEqual "show" (show 3) "3"-assertEqual "show" (show 3.14159) "3.14159"-assertEqual "show" (show [1, 2]) "[1, 2]"-assertEqual "show" (show "Hello world!") "\"Hello world!\""---- TODO: show-tsv--assertEqual "isBool" (isBool False) True--assertEqual "isInteger" (isInteger 1) True--assertEqual "isRational" (isRational 1) True-assertEqual "isRational" (isRational (1 / 2)) True-assertEqual "isRational" (isRational 3.1) False--assertEqual "isScalar" (isScalar 1) True-assertEqual "isScalar" (isScalar [| 1, 2 |]) False--assertEqual "isFloat" (isFloat 1.0) True-assertEqual "isFloat" (isFloat 1) False--assertEqual "isChar" (isChar 'c') True--assertEqual "isString" (isString "hoge") True--assertEqual "isCollection" (isCollection []) True-assertEqual "isCollection" (isCollection [1]) True--assertEqual "isHash" (isHash {| |}) True-assertEqual "isHash" (isHash {| (1, 2) |}) True--assertEqual "isTensor" (isTensor 1) False-assertEqual "isTensor" (isTensor [| 1 |]) True-assertEqual "isTensor" (isTensor (generateTensor (+) [1, 2])) True
− test/syntax.egi
@@ -1,719 +0,0 @@------ Syntax test---------- Primitive Data-----assertEqual "char literal"- ['a', '\n', '\'']- ['a', '\n', '\'']--assertEqual "string literal" "" ""-assertEqual "string literal" "abc\n" "abc\n"--assertEqual "bool literal"- [True, False]- [True, False]--assertEqual "integer literal"- [1, 0, -100, 1 - 100]- [1, 0, -100, -99]--assertEqual "rational number"- [10 / 3, 10 / 20, -1 / 2]- [10 / 3 , 1 / 2, -1 / 2]--assertEqual "float literal" [1.0, 0.0, -100.012001, 1.0 + 2] [1.0, 0.0, -100.012001, 3.0]--assertEqual "inductive data literal" A A--assertEqual "tuple literal" (1, 2, 3) (1, 2, 3)--assertEqual "collection literal" [1, 2, 3, 4, 5, 6] [1, 2, 3, 4, 5, 6]--assertEqual "collection between" [1..5] [1, 2, 3, 4, 5]-assertEqual "collection from" (take 5 [1..]) [1, 2, 3, 4, 5]--assertEqual "identifier with dot and operator" (b.* 1 2) 2------- Basic Sytax-----assertEqual "if"- (if True then True else False)- True--assertEqual "if"- (if False then True else False)- False--assertEqual "let binding"- (let t := (1, 2)- (x, y) := t- in x + y)- 3--assertEqual "let binding"- (let x := 1- y := x + 1- in y)- 2--assertEqual "let binding without newline"- (let { x := 1; y := x + 1 } in y)- 2--io $ do print "io and do expression"- return 0--io $ do { print "io and do expression without newline"; return 0 }--assertEqual "where"- (f 0 + y + 1- where f x := 2 + x- y := 3)- 6--assertEqual "nested where"- (f 0 + 1- where- f x := 2 + y + z- where y := 3- z := 4)- 10--assertEqual "multiple where in one expression"- (matchAll [1, 2, 3] as multiset integer with- | #1 :: $xs -> f xs- where f xs := length xs- | #2 :: #3 :: $xs -> g xs- where g xs := length xs)- [2, 1]--assertEqual "mutual recursion"- (let isEven n := if n = 0 then True else isOdd (n - 1)- isOdd n := if n = 0 then False else isEven (n - 1)- in isEven 10)- True--assertEqual "lambda and application"- ((\x -> x + 1) 10)- 11--assertEqual "application with binops"- ((\x y -> x + y) 1 2 + 3)- 6--assertEqual "lambda with case"- ((\() -> 1) ())- 1--assertEqual "lambda with case"- ((\(x, y, z) -> x - y - z) (1, 2, 3))- (-4)--assertEqual "lambda with case"- ((\_ -> 1) 2)- 1--assertEqual "append op" ([1] ++ [2]) [1, 2]-assertEqual "append op" ((++) [1] [2]) [1, 2]--assertEqual "apply op" ((+ 5) $ 1 + 2) 8--assertEqual "section" ((+) 10 1) 11-assertEqual "section" ((+ 1) 10) 11-assertEqual "section" (foldl (*) 1 [1..5]) 120-assertEqual "section" ((-) 10 1) 9-assertEqual "section" ((10 -) 1) 9-assertEqual "section" ((10 - ) 1) 9-assertEqual "section" ((-1 +) 2) 1-assertEqual "safe section - left assoc" ((1 + 2 +) 3) 6-assertEqual "safe section - right assoc" ((++ [1] ++ [2]) [3]) [3, 1, 2]-assertEqual "not section" (- 2) (1 - 3)---- user-defined infix-infixl expression 5 @-def (@) x y := x - y--assertEqual "user defined infix"- (4 @ 3 @ 5)- (-4)--infixl expression 5 @@-def (@@) %x y := x - y--assertEqual "user defined infix with tensor arg"- (4 @@ 3 @@ 2)- (-1)--def findFactor :=- memoizedLambda n ->- match takeWhile (<= floor (sqrt (itof n))) primes as list integer with- | _ ++ (?(\m -> divisor n m) & $x) :: _ -> x- | _ -> n--assertEqual "memoized lambda"- (map findFactor [1..10])- [1, 2, 3, 2, 5, 2, 7, 2, 3, 2]--def twinPrimes :=- matchAll primes as list integer with- | _ ++ $p :: #(p + 2) :: _ -> (p, p + 2)--assertEqual "twin primes"- (take 10 twinPrimes)- [(3, 5), (5, 7), (11, 13), (17, 19), (29, 31), (41, 43), (59, 61), (71, 73), (101, 103), (107, 109)]--def primeTriplets :=- matchAll primes as list integer with- | _ ++ $p :: ((#(p + 2) | #(p + 4)) & $m) :: #(p + 6) :: _- -> (p, m, p + 6)--assertEqual "prime triplets"- (take 10 primeTriplets)- [(5, 7, 11), (7, 11, 13), (11, 13, 17), (13, 17, 19), (17, 19, 23), (37, 41, 43), (41, 43, 47), (67, 71, 73), (97, 101, 103), (101, 103, 107)]--def someFunction x y z :=- x + y * z--assertEqual "function definition"- (someFunction 1 2 3)- 7--def someFunctionWithDollar $x $y $z :=- x + y + z--assertEqual "function definition with '$' scalar arg"- (someFunctionWithDollar 1 2 3)- 6--def gcd m n :=- if m >= n then- if n = 0 then m- else gcd n (m % n)- else gcd n m--assertEqual "recursive function definition"- (gcd 143 22)- 11--def A x := 1--assertEqual "definition of upper-case identifier"- (A 2)- 1--assertEqual "capply"- (capply (+) [1, 2])- 3--def f0 () := 1-def f2 (x, y) := x + y--assertEqual "nullary function definition"- (f0 ())- 1--assertEqual "function definition with tupled argument"- (f2 (1, 2))- 3--{-- This is a comment- -}--{-- {- We can nest comments! -}- {- {- nested -} comment -}- -}------- Pattern-Matching-----assertEqual "match"- (match 1 as integer with- | #0 -> 0- | $x -> 10 + x)- 11--assertEqual "match-all"- (matchAll [1, 2, 3] as multiset integer with- | $x :: _ -> x)- [1, 2, 3]--assertEqual "match-all-multi"- (matchAll [1, 2, 3] as multiset integer with- | $x :: #(x + 1) :: _ -> [x, x + 1]- | $x :: #(x + 2) :: _ -> [x, x + 2])- [[1, 2], [2, 3], [1, 3]]--assertEqual "match-lambda"- ((\match as list integer with- | [] -> 0- | $x :: _ -> x) [1, 2, 3])- 1--assertEqual "match-all-lambda"- ((\matchAll as list something with- | _ ++ $x :: _ -> x) [1, 2, 3])- [1, 2, 3]--assertEqual "match-all-lambda-multi"- ((\matchAll as multiset something with- | $x :: #(x + 1) :: _ -> [x, x + 1]- | $x :: #(x + 2) :: _ -> [x, x + 2]) [1, 2, 3])- [[1, 2], [2, 3], [1, 3]]--assert "nested pattern match"- (match [1, 2, 3] as list integer with- | #2 :: $x -> match x as multiset integer with- | _ -> False- | #1 :: $x -> match x as multiset integer with- | #1 :: _ -> False- | #2 :: _ -> True)--assertEqual "pattern variable"- (match 1 as something with $x -> x)- 1--assert "value pattern" (match 1 as integer with #1 -> True)--assert "inductive pattern"- (match [1, 2, 3] as list integer with- | snoc #3 _ -> True)--assert "collection pattern - nil"- (match [] as list integer with- | [] -> True)--assertEqual "collection pattern"- (match [1, 2, 3] as list integer with- | [#1, _, $x] -> x)- 3--assertEqual "collection pattern"- (matchAll [1, 2, 3, 4] as list integer with- | [_, _, _] -> True)- []--assert "and pattern"- (match [1, 2, 3] as list integer with- | #1 :: _ & snoc #3 _ -> True)--assert "and pattern"- (match [1, 2, 3] as list integer with- | #1 :: _ & #3 :: _ -> False- | _ -> True)--assert "or pattern"- (match [1, 2, 3] as list integer with- | snoc #1 _ | snoc #3 _ -> True)--assert "or pattern"- (match [1, 2, 3] as list integer with- | #2 :: _ | #1 :: _ -> True)--assert "not pattern"- (match [1, 2] as list integer with- | snoc !#1 _ -> True- | !#1 :: _ -> False)--assertEqual "not pattern"- (matchAll [1, 2, 2, 3, 3, 3] as multiset integer with- | $n :: !(#n :: _) -> n)- [1]--assert "predicate pattern"- (match [1, 2, 3] as list integer with- | ?(= 1) :: _ -> True)--assert "predicate pattern"- (match [1, 2, 3] as list integer with- | ?(= 2) :: _ -> False- | _ -> True)--assertEqual "indexed pattern variable"- (match 23 as mod 10 with- | $a_1 -> a)- {| (1, 23) |}--assert "loop pattern"- (match [3, 2, 1] as list integer with- | loop $i (1, [3], _)- (snoc #i ...)- [] -> True)--assertEqual "loop pattern"- (match [1..10] as list integer with- | loop $i (1, $n)- (#i :: ...)- [] -> n)- 10--assert "loop pattern"- (match [3, 2, 1] as list integer with- | loop $i (1, [3], _)- (snoc #i ...)- [] -> True)--assertEqual "double loop pattern"- (match [[1, 2, 3], [4, 5, 6], [7, 8, 9]] as (list (list integer)) with- | loop $i (1, [3], _)- ((loop $j (1, [3], _)- ($n_i_j :: ...)- []) :: ...)- [] -> n)- {| (1, {| (1, 1), (2, 2), (3, 3) |}),- (2, {| (1, 4), (2, 5), (3, 6) |}),- (3, {| (1, 7), (2, 8), (3, 9) |}) |}--assertEqual "let pattern"- (match [1, 2, 3] as list integer with- | let a := 42 in _ -> a)- 42--assertEqual "let pattern"- (match [1, 2, 3] as list integer with- | $a :: (let x := a in $xs) -> [x, xs])- [1, [2, 3]]--assertEqual "let pattern"- (match [1, 2, 3] as list integer with- | $a & (let n := length a in _) -> [a, n])- [[1, 2, 3], 3]--assertEqual "tuple pattern"- (matchAll (1, (2, 3)) as (integer, (integer, integer)) with- | ($m, ($n, $w)) -> [m, n, w])- [[1, 2, 3]]--assertEqual "tuple pattern"- (matchAll [(1, 1), (2, 2)] as multiset (integer, integer) with- | ($x, #x) :: _ -> x)- [1, 2]--assertEqual "pattern function call"- (let twin := \pat1 pat2 => (~pat1 & $x) :: #x :: ~pat2 in- match [1, 1, 1, 2, 3] as list integer with- | twin $n $ns -> [n, ns])- [1, [1, 2, 3]]--assertEqual "recursive pattern function call"- (let repeat := \pat => [] | ~pat :: (repeat ~pat) in- matchAll [1, 1, 1, 1] as list integer with- | repeat #1 -> "OK")- ["OK"]--assertEqual "loop pattern in pattern function"- (let comb n := \p =>- loop $i (1, n, _) (_ ++ ~p_i :: ...) _- in- matchAll [1, 2, 3, 4, 5] as (list integer) with- | (comb 2) $n -> n)- [{|(1, 1), (2, 2)|}, {|(1, 1), (2, 3)|},- {|(1, 2), (2, 3)|}, {|(1, 1), (2, 4)|},- {|(1, 2), (2, 4)|}, {|(1, 3), (2, 4)|},- {|(1, 1), (2, 5)|}, {|(1, 2), (2, 5)|},- {|(1, 3), (2, 5)|}, {|(1, 4), (2, 5)|}]--assertEqual "pairs of 2, natural numbers"- (take 10 (matchAll nats as set integer with- | $m :: $n :: _ -> [m, n]))- [[1, 1], [1, 2], [2, 1], [1, 3], [2, 2], [3, 1], [1, 4], [2, 3], [3, 2], [4, 1]]--assertEqual "pairs of 2, different natural numbers"- (take 10 (matchAll nats as list integer with- | _ ++ $m :: _ ++ $n :: _ -> [m, n]))- [[1, 2], [1, 3], [2, 3], [1, 4], [2, 4], [3, 4], [1, 5], [2, 5], [3, 5], [4, 5]]--assertEqual "combinations"- (matchAll [1,2,3] as list something with- | _ ++ $x :: _ ++ $y :: _ -> (x, y))- [(1, 2), (1, 3), (2, 3)]--assertEqual "permutations"- (matchAll [1,2,3] as multiset something with- | $x :: $y :: _ -> (x, y))- [(1, 2), (1, 3), (2, 1), (2, 3), (3, 1), (3, 2)]--def tree a := algebraicDataMatcher- | leaf- | node (tree a) a (tree a)--def treeInsert n t :=- match t as tree integer with- | leaf -> Node Leaf n Leaf- | node $t1 $m $t2 -> match (compare n m) as ordering with- | less -> Node (treeInsert n t1) m t2- | equal -> Node t1 n t2- | greater -> Node t1 m (treeInsert n t2)--def treeMember n t :=- match t as tree integer with- | leaf -> False- | node $t1 $m $t2 -> match (compare n m) as ordering with- | less -> treeMember n t1- | equal -> True- | greater -> treeMember n t2--assertEqual "tree set using algebraic-data-matcher"- (let t := foldr treeInsert Leaf [4, 1, 2, 4, 3]- in [treeMember 1 t, treeMember 0 t])- [True, False]--assert "sequential pattern"- (match [2,3,1,4,5] as list integer with- | { @ :: @ :: $x :: _,- (#(x + 1), @),- #(x + 2)}- -> True)--assertEqual "sequential not pattern"- (matchAll ([1,2,3], [4,3,5]) as (multiset eq, multiset eq) with- | { ($x :: @, #x :: @),- !($y :: _, #y :: _) }- -> x)- [3]--assertEqual "partial sequential pattern"- (matchAll ([1,2,3,2], [10,20]) as (list eq, list eq) with- | ({ @ ++ $x :: _, !(_ ++ #x :: _) }, $ys) -> (x, ys))- [(1, [10, 20]), (2, [10, 20]), (3, [10, 20])]--assertEqual "forall pattern 1"- (matchAll [1,5,3] as multiset integer with- | forall _ _ -> "ok")- ["ok"]--assertEqual "forall pattern 2"- (matchAll [1,5,3] as multiset integer with- | (forall ((@ & $x) :: _) ?isOdd) & $xs -> (x,xs))- [(1, [1, 5, 3]), (5, [1, 5, 3]), (3, [1, 5, 3])]--assertEqual "forall pattern 3"- (matchAllDFS [1,5,3] as multiset integer with- | forall ((@ & $x) :: _) ?isOdd -> x)- [1,5,3]--assertEqual "forall pattern 4"- (matchAll [1,5,3] as multiset integer with- | forall ((@ & $x) :: _) ?isOdd -> x)- [1, 5, 3]------- Tensor-----assertEqual "generate-tensor"- (generateTensor (*) [3, 5])- [| [| 1, 2, 3, 4, 5 |], [| 2, 4, 6, 8, 10 |], [| 3, 6, 9, 12, 15 |] |]--assertEqual "tensor"- (tensor [2, 5] [1, 2, 3, 4, 5, 2, 4, 6, 8, 10])- [| [| 1, 2, 3, 4, 5 |], [| 2, 4, 6, 8, 10 |] |]--assertEqual "tensor wedge expr"- (! min [| 1, 2, 3 |] [| 1, 2, 3 |])- [| [| 1, 1, 1 |], [| 1, 2, 2 |], [| 1, 2, 3 |] |]--assertEqual "tensor wedge expr of binary operator"- ([| 1, 2, 3 |] !+ [| 1, 2, 3 |])- [| [| 2, 3, 4 |], [| 3, 4, 5 |], [| 4, 5, 6 |] |]--assertEqual "tensor wedge expr of binary operator - section style"- ((!+) [| 1, 2, 3 |] [| 1, 2, 3 |])- [| [| 2, 3, 4 |], [| 3, 4, 5 |], [| 4, 5, 6 |] |]--assertEqual "tensor multiplication"- ([| 1, 2, 3 |]_i * [| 1, 2, 3 |]_i)- [| 1, 4, 9 |]_i--assertEqual "multi subscript"- (let i := {| (1, 1), (2, 2), (3, 3) |}- x := generateTensor (\x y z -> x + y + z) [5, 5, 5]- in x_(i_1)..._(i_3))- 6--def TestT := generateTensor 3#x_%1_%2_%3 [2,3,4]-def TestC_c_a_b := TestT_a_b_c--assertEqual "transpose"- TestC_#_#_#- (tensor [4, 2, 3]- [x_1_1_1, x_1_2_1, x_1_3_1, x_2_1_1, x_2_2_1, x_2_3_1,- x_1_1_2, x_1_2_2, x_1_3_2, x_2_1_2, x_2_2_2, x_2_3_2,- x_1_1_3, x_1_2_3, x_1_3_3, x_2_1_3, x_2_2_3, x_2_3_3,- x_1_1_4, x_1_2_4, x_1_3_4, x_2_1_4, x_2_2_4, x_2_3_4])_#_#_#--def symmT{_i_j} :=- [| [| 0, 1, 2 |],- [| 1, 0, 3 |],- [| 2, 3, 0 |] |]--def asymmT[_i_j] :=- [| [| 0, 1, 2 |],- [| -1, 0, 3 |],- [| -2, -3, 0 |] |]--assert "symmetric tensor"- (symmT_1_1 = 0 && symmT_1_2 = 1 && symmT_1_3 = 2 &&- symmT_2_1 = 1 && symmT_2_2 = 0 && symmT_2_3 = 3 &&- symmT_3_1 = 2 && symmT_3_2 = 3 && symmT_3_3 = 0)--assert "symmetric tensor"- (asymmT_1_1 = 0 && asymmT_1_2 = 1 && asymmT_1_3 = 2 &&- asymmT_2_1 = -1 && asymmT_2_2 = 0 && asymmT_2_3 = 3 &&- asymmT_3_1 = -2 && asymmT_3_2 = -3 && asymmT_3_3 = 0)------- Hash-----assertEqual "hash-literal"- {| (1, 11), (2, 12), (3, 13), (4, 14), (5, 15), |}- {| (1, 11), (2, 12), (3, 13), (4, 14), (5, 15), |}--assertEqual "empty hash-literal"- {| |}- {| |}--assertEqual "hash access"- {| (1, 11), (2, 12), (3, 13), (4, 14), (5, 15), |}_3- 13--assertEqual "string hash access"- {| ("1", 11), ("2", 12), ("3", 13), ("4", 14), ("5", 15) |}_"3"- 13--assertEqual "char hash access"- {| ('a', 11), ('b', 12), ('c', 13), ('d', 14), ('e', 15) |}_'c'- 13------- Partial Application-----assertEqual "partial application '#'"- (2#(10 * %1 + %2) 1 2)- 12--assertEqual "recursive partial application '#'"- (take 10 (1#(%1 :: (%0 (%1 * 2))) 2))- [2, 4, 8, 16, 32, 64, 128, 256, 512, 1024]--def f *$x *$y := x + y--assertEqual "double inverted index"- (f [|1, 2, 3|]_i [|10, 20, 30|]_j)- [| [| 11, 21, 31, |], [| 12, 22, 32, |], [| 13, 23, 33, |], |]~i~j--def g $x *$y := x + y--assertEqual "single inverted index"- (g [|1, 2, 3|]_i [|10, 20, 30|]_j)- [| [| 11, 21, 31, |], [| 12, 22, 32, |], [| 13, 23, 33, |], |]_i~j------- matcherExpr-----def list a := matcher- | [] as () with- | [] -> [()]- | _ -> []- | $ :: $ as (a, list a) with- | $x :: $xs -> [(x, xs)]- | _ -> []- | snoc $ $ as (a, list a) with- | snoc $xs $x -> [(x, xs)]- | _ -> []- | _ ++ $ as (list a) with- | $tgt -> matchAll tgt as list a with- | loop $i (1, _) (_ :: ...) $rs -> rs- | $ ++ $ as (list a, list a) with- | $tgt -> matchAll tgt as list a with- | loop $i (1, $n) ($xa_i :: ...) $rs ->- (foldr (\%i %r -> xa_i :: r) [] [1..n], rs)- | nioj $ $ as (list a, list a) with- | $tgt -> matchAll tgt as list a with- | loop $i (1, $n) (snoc $xa_i ...) $rs ->- (foldr (\%i %r -> r ++ [xa_i]) [] [1..n], rs)- | #$val as () with- | $tgt -> if val = tgt then [()] else []- | $ as something with- | $tgt -> [tgt]--def multiset a := matcher- | [] as () with- | $tgt -> match tgt as (mutiset a) with- | [] -> [()]- | _ -> []- | $ :: $ as (a, multiset a) with- | $tgt -> matchAll tgt as list a with- | $hs ++ $x :: $ts -> (x, hs ++ ts)- | #$val as () with- | $tgt -> match (val, tgt) as (list a, multiset a) with- | ([], []) -> [()]- | ($x :: $xs, #x :: #xs) -> [()]- | (_, _) -> []- | $ as something with- | $tgt -> [tgt]--assertEqual "matcher definition"- (matchAll [1, 2, 3] as multiset integer with- | $x :: _ -> x)- [1, 2, 3]--def nishiwakiIf b e1 e2 :=- head (matchAll b as (matcher- | $ as something with- | True -> [e1]- | False -> [e2]) with- | $x -> x)--assertEqual "case 1" (nishiwakiIf True 1 2) 1-assertEqual "case 2" (nishiwakiIf False 1 2) 2-assertEqual "case 3" (nishiwakiIf (1 = 1) 1 2) 1---- User-defined pattern infix--infixl pattern 7 <>-infixl pattern 4 <?> -- '?' is allowed from the 2nd character--def dummyMatcher := matcher- | $ <> $ as (integer, integer) with- | $x :: $y :: [] -> [(x, y)]- | _ -> []- | $ <?> $ as (integer, list integer) with- | $x :: $xs -> [(x, xs)]- | _ -> []--assertEqual "user-defined pattern infix"- (match [1, 2] as dummyMatcher with $x <> $y -> x + y)- 3--assertEqual "user-defined pattern infix"- (match [1, 2] as dummyMatcher with $x <?> $y :: _ -> x + y)- 3---- Primitive data pattern match with let expression-assertEqual "let pattern match"- (let (x :: xs) := [1, 2, 3] in (x, xs))- (1, [2, 3])--assertEqual "let pattern match"- (let (snoc xs x) := [1, 2, 3] in (x, xs))- (3, [1, 2])--assertEqual "let pattern match"- (let (Just x) := Just 1 in x)- 1--assertEqual "let pattern match"- (let (x, y) := (2, 3) in x + y)- 5