sweet-egison 0.1.1.3 → 0.1.2.0

raw patch · 6 files changed

+56/−19 lines, 6 filesdep ~backtrackingdep ~egison-pattern-srcdep ~egison-pattern-src-th-modePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: backtracking, egison-pattern-src, egison-pattern-src-th-mode, logict

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• src/Control/Egison/Matcher/Collection.hs +29/−1
• src/Control/Egison/Matcher/Pair.hs +8/−11
• src/Control/Egison/QQ.hs +8/−0
• sweet-egison.cabal +6/−6
• test/Control/EgisonSpec.hs +1/−1

@@ -1,3 +1,7 @@+## 0.1.2.0++- Support GHC 9.10.1+ ## 0.1.0.0  - Initial Release

@@ -48,6 +48,13 @@   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)+  app :: Pattern (PP t, PP t) m t (t -> t, t)+  appM :: m -> t -> (Something, m)+  default appM :: m -> t -> (Something, m)+  {-# INLINE appM #-}+  appM m _ = (Something, m)+  appCons :: Pattern (PP (t -> t), PP (ElemT t), PP t) m t (t -> t, ElemT t, t)+  appConsM :: m -> t -> (Something, ElemM m, m)  -- | 'List' matcher is a matcher for collections that matches as if they're normal lists. newtype List m = List m@@ -85,6 +92,21 @@     f rhs (x : ts) = (reverse rhs, x, ts) : f (x : rhs) ts   {-# INLINE joinConsM #-}   joinConsM (List m) _ = (List m, m, List m)+  {-# INLINABLE app #-}+  app (WC, _) _ xs       = map (\ts -> (undefined, ts)) (tails xs)+  app _       _ []       = pure (id, [])+  app ps      m (x : xs) = pure (id, x : xs) `mplus` do+    (ys, zs) <- app ps m xs+    pure (\ls -> x : ys ls, zs)+  {-# INLINABLE appCons #-}+  appCons (WC, _, WC) (List _) tgt = [ (undefined, x, undefined) | x <- tgt ]+  appCons (WC, _, _) (List _) tgt  = [ (undefined, x, rs) | (x:rs) <- tails tgt ]+  appCons (_, _, _) (List _) tgt   = f id tgt+   where+    f _ [] = []+    f hs (x : ts) = (hs, x, ts) : f (hs . (x :)) ts+  {-# INLINABLE appConsM #-}+  appConsM (List m) _ = (Something, 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@@ -115,6 +137,9 @@   elmM = undefined   joinCons = undefined   joinConsM = undefined+  app = undefined+  appCons = undefined+  appConsM = undefined  instance (Eq a, Matcher m a, ValuePattern m a) => ValuePattern (Multiset m) [a] where   value e () (Multiset m) v =@@ -142,6 +167,9 @@   elmM = undefined   joinCons = undefined   joinConsM = undefined+  app = undefined+  appCons = undefined+  appConsM = undefined  instance (Eq a, Matcher m a, ValuePattern m a) => ValuePattern (Set m) [a] where   value e () (Set m) v = if eqAs (List m) (Set m) e v then pure () else mzero@@ -153,7 +181,7 @@ eqAs m1 m2 xs ys = match   dfs   (xs, ys)-  (Pair m1 m2)+  (m1, m2)   [ [mc| ([], []) -> True |]   , [mc| ($x : $xs, #x : $ys) -> eqAs m1 m2 xs ys |]   , [mc| _ -> False |]

@@ -5,8 +5,7 @@ -- Stability:   experimental  module Control.Egison.Matcher.Pair-  ( Pair(..)-  , tuple2+  ( tuple2   , tuple2M   ) where@@ -17,18 +16,16 @@ import           Control.Egison.Matcher import           Control.Egison.QQ -data Pair m1 m2 = Pair m1 m2--instance (Matcher m1 t1, Matcher m2 t2) => Matcher (Pair m1 m2) (t1, t2)+instance (Matcher m1 t1, Matcher m2 t2) => Matcher (m1, m2) (t1, t2) -tuple2 :: Pattern (PP t1, PP t2) (Pair m1 m2) (t1, t2) (t1, t2)-tuple2 _ (Pair _ _) (t1, t2) = pure (t1, t2)+tuple2 :: Pattern (PP t1, PP t2) (m1, m2) (t1, t2) (t1, t2)+tuple2 _ (_, _) (t1, t2) = pure (t1, t2) -tuple2M :: Pair m1 m2 -> (t1, t2) -> (m1, m2)-tuple2M (Pair m1 m2) _ = (m1, m2)+tuple2M :: (m1, m2) -> (t1, t2) -> (m1, m2)+tuple2M (m1, m2) _ = (m1, m2) -instance (Eq a1, Matcher m1 a1, ValuePattern m1 a1, Eq a2, Matcher m2 a2, ValuePattern m2 a2) => ValuePattern (Pair m1 m2) (a1, a2) where-  value (e1, e2) () (Pair m1 m2) (v1, v2) =+instance (Eq a1, Matcher m1 a1, ValuePattern m1 a1, Eq a2, Matcher m2 a2, ValuePattern m2 a2) => ValuePattern (m1, m2) (a1, a2) where+  value (e1, e2) () (m1, m2) (v1, v2) =     if eqAs m1 e1 v1 && eqAs m2 e2 v2 then pure () else mzero  eqAs :: (Matcher m t, ValuePattern m t) => m -> t -> t -> Bool

@@ -79,6 +79,7 @@ listFixities =   [ ParseFixity (Fixity AssocRight (Precedence 5) (mkName "join")) $ parser "++"   , ParseFixity (Fixity AssocRight (Precedence 5) (mkName "cons")) $ parser ":"+  , ParseFixity (Fixity AssocRight (Precedence 5) (mkName "app" )) $ parser "$"   ]  where   parser symbol content | symbol == content = Right ()@@ -171,6 +172,13 @@   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+  -- PROBLEM: Ad-hoc optimization+  go (Pat.Infix c1 p1 (Pat.Infix c2 p2 p3)) mName tName body+    | nameBase c1 == "app", nameBase c2 == "cons" = go+      (Pattern (mkName "appCons") [p1, p2, p3])       mName       tName       body

@@ -1,6 +1,6 @@ cabal-version:      2.0 name:               sweet-egison-version:            0.1.1.3+version:            0.1.2.0 synopsis:   Shallow embedding implementation of non-linear pattern matching @@ -23,7 +23,7 @@   README.md  -- see .github/workflows-tested-with:        GHC ==8.6.2 || ==8.6.5 || ==8.8.1+tested-with:        GHC ==9.10.1  source-repository head   type:     git@@ -40,13 +40,13 @@     Control.Egison.QQ    build-depends:-      backtracking                ^>=0.1+      backtracking     , base                        >=4.8   && <5-    , egison-pattern-src          ^>=0.2.1-    , egison-pattern-src-th-mode  ^>=0.2.1+    , egison-pattern-src+    , egison-pattern-src-th-mode     , haskell-src-exts     , haskell-src-meta-    , logict                      ^>=0.7.0+    , logict     , template-haskell     , transformers 

@@ -42,7 +42,7 @@   [ testCase "pair" $ assertEqual "simple" (1, 2) $ match       dfs       (1, 2)-      (Pair Something Something)+      (Something, Something)       [[mc| ($x, $y) -> (x, y) |]]   ]