diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,3 @@ -## 0.1.0.1 +## 0.1.0.0 - Initial Release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ [![Hackage Deps](https://img.shields.io/hackage-deps/v/sweet-egison.svg)](http://packdeps.haskellers.com/reverse/sweet-egison) The [Sweet Egison](https://hackage.haskell.org/package/sweet-egison) is a shallow embedding implementation of non-linear pattern matching with extensible and polymorphic patterns [1]. -This library desguars the [Egison](https:///www.egison.org) pattern-match expressions into Haskell programs that use non-deterministic monads. +This library desguars the [Egison](https:///www.egison.org) pattern-match expressions into Haskell programs that use [non-deterministic monads](https://github.com/egison/backtracking). This library provides a base of the pattern-match-oriented (PMO) programming style [2] for Haskell users at a practical level of efficiency. ## Getting started @@ -53,19 +53,20 @@ These parameters such as `Multiset Something`, `List (List Something)`, and `Something` are called *matchers* and specify pattern-matching methods. Given a matcher `m`, `Multiset m` is a matcher for multisets that matches its elements with `m`. `Something` is a matcher that provides simple matching methods for an arbitrary value. +Pattern constructors such as `:` and `++` are overloaded over matchers for collections to archive the ad-hoc polymorphism of patterns. ### Controlling matching strategy -Some pattern matching have infinitely many results and `matchAll` is designed to be able to enumerate all the results. -For this purpose, `matchAll` traverses a search tree for pattern matching in the breadth-first order. +Some pattern matching have infinitely many results and `matchAll bfs` is designed to be able to enumerate all the results. +For this purpose, `matchAll bfs` traverses a search tree for pattern matching in the breadth-first order. The following example illustrates this: ```haskell -> take 10 $ matchAll dfs [1 ..] (Set Something) [[mc| $x : $y : _ -> (x, y) |]] +> take 10 $ matchAll bfs [1 ..] (Set Something) [[mc| $x : $y : _ -> (x, y) |]] [(1,1),(2,1),(1,2),(3,1),(1,3),(2,2),(1,4),(4,1),(1,5),(2,3)] ``` -We can use the depth-first search with `matchAllDFS`. +We can use the depth-first search with `matchAll dfs`. ```haskell > take 10 $ matchAll dfs [1 ..] (Set Something) [[mc| $x : $y : _ -> (x, y) |]] @@ -73,9 +74,9 @@ ``` In most cases, the depth-first search is faster than the default breadth-first search strategy. -It is recommended to always use `matchAllDFS` if it is OK to do so. +It is recommended to always use `matchAll dfs` if it is OK to do so. -With `matchAllDFS`, we can define an intuitive pattern-matching version of `concat` function on lists. +With `matchAll dfs`, we can define an intuitive pattern-matching version of `concat` function on lists. ```haskell > concat xs = matchAll dfs xs (List (List Something)) [[mc| _ ++ (_ ++ $x : _) : _ -> x |]] @@ -101,7 +102,7 @@ Match clauses are monoids and can be concatenated using `<>`. ```haskell -> member x xs = matchDFS xs (Multiset Eql) [[mc| #x : _ -> True |], [mc| _ -> False |]] +> member x xs = match dfs xs (Multiset Eql) [[mc| #x : _ -> True |], [mc| _ -> False |]] > member 1 [3,4,1,4] True > intersect xs ys = matchAll dfs (xs, ys) (Pair (Set Eql) (Set Eql)) [[mc| ($x : _, #x : _) -> x |]] @@ -115,40 +116,85 @@ Detailed information of Egison, the original PMO language implementation, can be found on [https://www.egison.org/](https://www.egison.org/) or in [1]. You can learn more about pattern-match-oriented programming style in [2]. -## Implementation / Difference from miniEgison -[miniEgison](https://github.com/egison/egison-haskell) is also a Haskell library that implements Egison pattern matching. -The main difference from [miniEgison](https://github.com/egison/egison-haskell) is that sweet-egison translates pattern matching into Haskell control expressions (shallow embedding), where [miniEgison](https://github.com/egison/egison-haskell) translates it into Haskell data expressions (deep embedding). +## Implementation +Sweet Egison transform patterns into a program that uses non-deterministic monads. Our quasi-quoter `mc` translates match clauses into functions that take a target and return a non-deterministic computation as `MonadPlus`-like monadic expression. -As `MonadPlus` can express backtracking computation, we can perform efficient backtracking pattern matching that is essential to PMO programming on it. - -For example, `[mc| $xs ++ $x : $ys -> (xs, x, ys) |]` is translated as follows: - +As `MonadPlus` can express backtracking computation, we can perform efficient backtracking pattern matching. +For example, the match clause `[mc| $x : #(x + 10) : _ -> (x, x + 10) |]` is transformed as follows: ```haskell -\tgt -> - join tgt >-> \(xs, d0) -> - cons d0 >-> \(x, ys) -> - pure (xs, x, ys) + \ (mat_a5sV, tgt_a5sW) + -> let (tmpM_a5sX, tmpM_a5sY) = (consM mat_a5sV) tgt_a5sW + in + ((fromList (((cons (GP, GP)) mat_a5sV) tgt_a5sW)) + >>= + (\ (tmpT_a5sZ, tmpT_a5t0) + -> let x = tmpT_a5sZ in + let (tmpM_a5t1, tmpM_a5t2) = (consM tmpM_a5sY) tmpT_a5t0 + in + ((fromList (((cons (GP, WC)) tmpM_a5sY) tmpT_a5t0)) + >>= + (\ (tmpT_a5t3, tmpT_a5t4) + -> ((fromList ((((value (x + 10)) ()) tmpM_a5t1) tmpT_a5t3)) + >>= (\ () -> pure (x, x + 10))))))) ``` +The infix operators `:` and `++` are synonyms of `cons` and `join`, respectively, and desugared in that way during translation. +The `matchAll` function is defined as a function that creates and passes the argument for this non-deterministic monads. ```haskell -\(mat, tgt) -> - join mat tgt >>= \((m0, m1), (xs, d0)) -> - cons m1 d0 >>= \((m2, m3), (x, ys)) -> - pure (xs, x, ys) +matchAll strategy target matcher = + concatMap (\b -> toList (strategy (matcher, target) >>= b)) ``` +Consequently, the pattern-match expression ```haskell --- $hs ++ $ts -> (hs, ts) -\tgt -> - join tgt >>= \(hs, ts) -> - pure (hs, ts) +matchAll dfs [1, 2, 3, 12] (Multiset Eql) + [[mc| $x : #(x + 10) : _ -> (x, x + 10) |]] +-- [(2, 12)] ``` +is transformed into a program that is equivalent to the following: +```haskell +concatMap (\b -> toList (dfs (Multiset Eql, [1, 2, 3, 12]) >>= b)) + [\ (mat_a5sV, tgt_a5sW) + -> let (tmpM_a5sX, tmpM_a5sY) = (consM mat_a5sV) tgt_a5sW + in + ((fromList (((cons (GP, GP)) mat_a5sV) tgt_a5sW)) + >>= + (\ (tmpT_a5sZ, tmpT_a5t0) + -> let x = tmpT_a5sZ in + let (tmpM_a5t1, tmpM_a5t2) = (consM tmpM_a5sY) tmpT_a5t0 + in + ((fromList (((cons (GP, WC)) tmpM_a5sY) tmpT_a5t0)) + >>= + (\ (tmpT_a5t3, tmpT_a5t4) + -> ((fromList ((((value (x + 10)) ()) tmpM_a5t1) tmpT_a5t3)) + >>= (\ () -> pure (x, x + 10)))))))] +``` +### MiniEgison (Deep Embedding) vs. Sweet Egison (Shallow Embedding) -`:` and `++` are synonyms of `cons` and `join` respectively, and desugared in that way during translation. -Here, pattern constructor names such as `join` and `cons` are overloaded over matchers of collections to archive the ad-hoc polymorphism of patterns. +[miniEgison](https://github.com/egison/egison-haskell) is also a Haskell library that implements Egison pattern matching. +The main difference between [miniEgison](https://github.com/egison/egison-haskell) and Sweet Egison is that Sweet Egison translates pattern matching into Haskell control expressions (shallow embedding), whereas [miniEgison](https://github.com/egison/egison-haskell) translates it into Haskell data expressions (deep embedding). +As a result, Sweet Egison is faster than miniEgison. +The following benchmark is taken using MacBook Pro (2017, 2.3 GHz Intel Core i5). + +| | comb2 (n = 15000) | perm2 (n = 5000) | CDCL (50 vars) | +|--------------|-------------------|------------------|----------------| +| miniEgison | 13.029 sec | 3.854 sec | 1.025 sec | +| Sweet Egison | 0.303 sec | 0.462 sec | 0.097 sec | + +There is almost no execution performance differences between programs written using list comprehensions and Sweet Egison. + +| | comb2 (n = 15000) | comb2 (n = 15000) | perm2 (n = 5000) | perm2 (n = 10000) | +|---------------------|-------------------|-------------------|------------------|-------------------| +| List Comprehensions | 0.347 sec | 1.244 sec | 0.409 sec | 2.077 sec | +| Sweet Egison | 0.309 sec | 1.081 sec | 0.434 sec | 1.984 sec | + +Programs used for the above benchmarks are follows: +* [sample/comb2.hs](https://github.com/egison/sweet-egison/blob/master/sample/comb2.hs) +* [sample/perm2.hs](https://github.com/egison/sweet-egison/blob/master/sample/perm2.hs) +* [sample/cdcl.hs](https://github.com/egison/sweet-egison/blob/master/sample/cdcl.hs) ## Bibliography diff --git a/src/Control/Egison/Matcher/Collection.hs b/src/Control/Egison/Matcher/Collection.hs --- a/src/Control/Egison/Matcher/Collection.hs +++ b/src/Control/Egison/Matcher/Collection.hs @@ -41,15 +41,19 @@ nilM _ _ = () -- | Pattern that destructs collections into its head and tail. -- @:@ is desugared into 'cons' by the quasi-quoter. - cons :: Pattern (PP, PP) m t (ElemT t, t) + cons :: Pattern (PP (ElemT t), PP t) m t (ElemT t, t) consM :: m -> t -> (ElemM m, m) -- | Pattern that destructs collections into its initial prefix and remaining suffix. -- @++@ is desugared into 'join' by the quasi-quoter. - join :: Pattern (PP, PP) m t (t, t) + join :: Pattern (PP t, PP t) m t (t, t) joinM :: m -> t -> (m, m) default joinM :: m -> t -> (m, m) {-# INLINE joinM #-} joinM m _ = (m, m) + elm :: Pattern (PP (ElemT t)) m t (ElemT t) + elmM :: m -> t -> ElemM m + joinCons :: Pattern (PP t, PP (ElemT t), PP t) m t (t, ElemT t, t) + joinConsM :: m -> t -> (m, ElemM m, m) -- | 'List' matcher is a matcher for collections that matches as if they're normal lists. newtype List m = List m @@ -57,6 +61,7 @@ instance Matcher m t => Matcher (List m) [t] instance Matcher m t => CollectionPattern (List m) [t] where + {-# SPECIALIZE instance Matcher m t => CollectionPattern (List m) [t] #-} type ElemM (List m) = m type ElemT [t] = t {-# INLINE nil #-} @@ -73,6 +78,17 @@ join ps m (x : xs) = pure ([], x : xs) `mplus` do (ys, zs) <- join ps m xs pure (x : ys, zs) + {-# INLINE elm #-} + elm _ (List m) xs = xs + {-# INLINE elmM #-} + elmM (List m) _ = m + {-# INLINE joinCons #-} + joinCons (_, _, _) (List m) = f [] + where + f _ [] = [] + f rhs (x : ts) = (reverse rhs, x, ts) : f (x : rhs) ts + {-# INLINE joinConsM #-} + joinConsM (List m) _ = (List m, m, List m) instance (Eq a, Matcher m a, ValuePattern m a) => ValuePattern (List m) [a] where value e () (List m) v = if eqAs (List m) (List m) e v then pure () else mzero @@ -82,6 +98,7 @@ instance Matcher m t => Matcher (Multiset m) [t] instance Matcher m t => CollectionPattern (Multiset m) [t] where + {-# SPECIALIZE instance Matcher m t => CollectionPattern (Multiset m) [t] #-} type ElemM (Multiset m) = m type ElemT [t] = t {-# INLINE nil #-} @@ -108,6 +125,7 @@ instance Matcher m t => Matcher (Set m) [t] instance Matcher m t => CollectionPattern (Set m) [t] where + {-# SPECIALIZE instance Matcher m t => CollectionPattern (Set m) [t] #-} type ElemM (Set m) = m type ElemT [t] = t {-# INLINE nil #-} diff --git a/src/Control/Egison/Matcher/Pair.hs b/src/Control/Egison/Matcher/Pair.hs --- a/src/Control/Egison/Matcher/Pair.hs +++ b/src/Control/Egison/Matcher/Pair.hs @@ -21,7 +21,7 @@ instance (Matcher m1 t1, Matcher m2 t2) => Matcher (Pair m1 m2) (t1, t2) -tuple2 :: Pattern (PP, PP) (Pair m1 m2) (t1, t2) (t1, t2) +tuple2 :: Pattern (PP t1, PP t2) (Pair m1 m2) (t1, t2) (t1, t2) tuple2 _ (Pair m1 m2) (t1, t2) = pure (t1, t2) tuple2M :: Pair m1 m2 -> (t1, t2) -> (m1, m2) diff --git a/src/Control/Egison/QQ.hs b/src/Control/Egison/QQ.hs --- a/src/Control/Egison/QQ.hs +++ b/src/Control/Egison/QQ.hs @@ -142,6 +142,7 @@ (VarE tName) ) `sbind_` LamE [TupP []] body + go (Pat.Predicate e) _ tName body = pure $ AppE (VarE 'Control.Monad.Search.guard) (AppE e (VarE tName)) `sbind_` LamE [TupP []] body go (Pat.And p1 p2) mName tName body = go p2 mName tName body >>= go p1 mName tName go (Pat.Or p1 p2) mName tName body = do @@ -151,11 +152,17 @@ go (Pat.Not p) mName tName body = do r <- go p mName tName (AppE (VarE 'pure) (TupE [])) pure $ AppE (VarE lnotName) r `sbind_` LamE [TupP []] body - go (Pat.Infix n p1 p2) mName tName body = - go (Pattern n [p1, p2]) mName tName body go (Pat.Collection ps) mName tName body = go (desugarCollection ps) mName tName body go (Pat.Tuple ps) mName tName body = go (desugarTuple ps) mName tName body + -- PROBLEM: Ad-hoc optimization + go (Pat.Infix c1 Pat.Wildcard (Pat.Infix c2 p Pat.Wildcard)) mName tName body | nameBase c1 == "join", nameBase c2 == "cons" = + go (Pattern (mkName "elm") [p]) mName tName body + -- PROBLEM: Ad-hoc optimization + go (Pat.Infix c1 p1 (Pat.Infix c2 p2 p3)) mName tName body | nameBase c1 == "join", nameBase c2 == "cons" = + go (Pattern (mkName "joinCons") [p1, p2, p3]) mName tName body + go (Pat.Infix n p1 p2) mName tName body = + go (Pattern n [p1, p2]) mName tName body go (Pat.Pattern cName ps) mName tName body = do mNames <- mapM (\_ -> newName "tmpM") ps tNames <- mapM (\_ -> newName "tmpT") ps @@ -183,8 +190,9 @@ desugarTuple ps = Pat.Pattern (mkName name) ps where name = "tuple" ++ show (length ps) -data PP = WC | GP +data PP a = WC | VP a | GP toPP :: Pat.Expr Name Name Exp -> Exp toPP Pat.Wildcard = ConE 'WC +toPP (Pat.Value e) = AppE (ConE 'VP) e toPP _ = ConE 'GP diff --git a/sweet-egison.cabal b/sweet-egison.cabal --- a/sweet-egison.cabal +++ b/sweet-egison.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: sweet-egison -version: 0.1.0.1 +version: 0.1.0.2 synopsis: Shallow embedding implementation of non-linear pattern matching diff --git a/test/Control/EgisonSpec.hs b/test/Control/EgisonSpec.hs --- a/test/Control/EgisonSpec.hs +++ b/test/Control/EgisonSpec.hs @@ -131,22 +131,18 @@ test_prime :: [TestTree] test_prime = - [ testCase "prime twins" + [ testCase "prime twins (value pattern)" $ assertEqual "simple" - [ (3 , 5) - , (5 , 7) - , (11 , 13) - , (17 , 19) - , (29 , 31) - , (41 , 43) - , (59 , 61) - , (71 , 73) - , (101, 103) - , (107, 109) - ] + [(3,5),(5,7),(11,13),(17,19),(29,31),(41,43),(59,61),(71,73),(101,103),(107,109)] $ take 10 $ matchAll bfs primes (List Eql) [[mc| _ ++ $p : #(p+2) : _ -> (p, p+2) |]] + , testCase "prime twins (predicate pattern)" + $ assertEqual + "simple" + [(3,5),(5,7),(11,13),(17,19),(29,31),(41,43),(59,61),(71,73),(101,103),(107,109)] + $ take 10 + $ matchAll bfs primes (List Eql) [[mc| _ ++ $p : ?(\x -> x == p + 2) : _ -> (p, p+2) |]] , testCase "(p, p+6)" $ assertEqual "simple" [(5, 11), (7, 13), (11, 17), (13, 19), (17, 23)] $ take 5 @@ -154,23 +150,13 @@ primes (List Eql) [[mc| _ ++ $p : _ ++ #(p+6) : _ -> (p, p+6) |]] --- , testCase "prime triplets" --- $ assertEqual --- "simple" --- [ (5 , 7 , 11) --- , (11 , 13 , 17) --- , (7 , 11 , 13) --- , (17 , 19 , 23) --- , (13 , 17 , 19) --- , (41 , 43 , 47) --- , (37 , 41 , 43) --- , (67 , 71 , 73) --- , (101, 103, 107) --- , (97 , 101, 103) --- ] --- $ take 10 --- $ matchAll bfs --- primes --- (List Eql) --- [[mc| _ ++ $p : $m : #(p+6) : _ -> (p, m, p+6) |]] + , testCase "prime triplets" + $ assertEqual + "simple" + [(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)] + $ take 10 + $ matchAll bfs + primes + (List Eql) + [[mc| _ ++ $p : $m : #(p+6) : _ -> (p, m, p+6) |]] ]