mini-egison 0.1.2 → 0.1.3

raw patch · 5 files changed

+66/−47 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +18/−3
• mini-egison.cabal +1/−1
• src/Control/Egison/Core.hs +22/−17
• src/Control/Egison/Match.hs +8/−0
• src/Control/Egison/Matcher.hs +17/−26

@@ -117,15 +117,22 @@  ### Matcher definitions -preparing+The users can define pattern-matching algorithms for each pattern by themselves. +preparing...+ ```+matchAll (1,2) UnorderedEqlPair [[mc| uepair $x $y => (x,y) |]]+-- [(1,2),(2,1)]+ matchAll (1,2) UnorderedEqlPair [[mc| uepair #2 $x => x |]] -- [1]-matchAll (1,2) (UnorderedPair Eql) [[mc| upair #2 $x => x |]]--- [1] ``` +A matcher is represented as a data type whose name and constructor's name is identical.++preparing...+ ``` data UnorderedEqlPair = UnorderedEqlPair instance (Eq a) => Matcher UnorderedEqlPair (a, a)@@ -137,6 +144,14 @@ uepair p1 p2 = Pattern (\_ UnorderedEqlPair (t1, t2) ->                           [twoMAtoms (MAtom p1 Eql t1) (MAtom p2 Eql t2)                           ,twoMAtoms (MAtom p1 Eql t2) (MAtom p2 Eql t1)])+```++```+matchAll (1,2) (UnorderedPair Eql) [[mc| uepair $x $y => (x,y) |]]+-- [(1,2),(2,1)]++matchAll (1,2) (UnorderedPair Eql) [[mc| upair #2 $x => x |]]+-- [1] ```  ```

@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           mini-egison-version:        0.1.2+version:        0.1.3 synopsis:    Template Haskell Implementation of Egison Pattern Matching description: This package provides the pattern-matching facility that fulfills the following three criteria for practical pattern matching for non-free data types\: (i) non-linear pattern matching with backtracking; (ii) extensibility of pattern-matching algorithms; (iii) ad-hoc polymorphism of patterns.   Non-free data types are data types whose data have no standard forms.

@@ -6,11 +6,11 @@ {-# LANGUAGE TypeOperators             #-}  module Control.Egison.Core (-  -- Pattern+  -- * Patterns   Pattern(..),   Matcher(..),   MatchClause(..),-  -- Matching state+  -- * Matching states and matching atoms   MState(..),   MAtom(..),   MList(..),@@ -18,7 +18,7 @@   oneMAtom,   twoMAtoms,   threeMAtoms,-  -- Heterogeneous list+  -- * Heterogeneous lists   HList(..),   happend,   (:++:),@@ -33,10 +33,9 @@ --- Pattern --- --- a: the type of the target--- m: a matcher passed to the pattern--- ctx: the intermediate pattern-matching result--- vs: the list of types bound to the pattern variables in the pattern.+-- | A pattern for data of a type @a@ for a matcher @m@.+-- @ctx@ is an intermediate pattern-matching result and a type of a list of data bound in the left-side of the pattern.+-- @vs@ is a list of types bound to the pattern variables in this pattern. data Pattern a m ctx vs where   Wildcard :: Pattern a m ctx '[]   PatVar :: String -> Pattern a m ctx '[a]@@ -44,31 +43,36 @@   OrPat  :: Pattern a m ctx vs -> Pattern a m ctx vs -> Pattern a m ctx vs   NotPat :: Pattern a m ctx '[] -> Pattern a m ctx '[]   PredicatePat :: (HList ctx -> a -> Bool) -> Pattern a m ctx '[]-  -- User-defined pattern; pattern is a function that takes a target, an intermediate pattern-matching result, and a matcher and returns a list of lists of matching atoms.+  -- | User-defined pattern; pattern is a function that takes a target, an intermediate pattern-matching result, and a matcher and returns a list of lists of matching atoms.   Pattern :: Matcher m a => (HList ctx -> m -> a -> [MList ctx vs]) -> Pattern a m ctx vs +-- | @m@ is a matcher for data of a type @a@. class Matcher m a +-- | A match clause of a match expression whose target data is @a@ and matcher is @m@.+-- The body of the match clause is evaluated to @b@. data MatchClause a m b = forall vs. (Matcher m a) => MatchClause (Pattern a m '[] vs) (HList vs -> b)  --- --- Matching state --- +-- | A matching state.+-- A matching state consists of an intermediate pattern-matching result and a stack of matching atoms. data MState vs where   MState :: vs ~ (xs :++: ys) => HList xs -> MList xs ys -> MState vs --- matching atom--- ctx: intermediate pattern-matching results--- vs: list of types bound to the pattern variables in the pattern.+-- | A matching atom.+-- @ctx@ is a intermediate pattern-matching result.+-- @vs@ is a list of types bound to the pattern variables by processing this matching atom. data MAtom ctx vs = forall a m. (Matcher m a) => MAtom (Pattern a m ctx vs) m a --- stack of matching atoms+-- | A stack of matching atoms data MList ctx vs where   MNil :: MList ctx '[]   MCons :: MAtom ctx xs -> MList (ctx :++: xs) ys -> MList ctx (xs :++: ys)-  MJoin :: MList ctx xs -> MList (ctx :++: xs) ys -> MList ctx (xs :++: ys) +-- | Concatenate two lists of matching atoms. mappend :: MList ctx xs -> MList (ctx :++: xs) ys -> MList ctx (xs :++: ys) mappend MNil atoms = atoms mappend (MCons atom atoms1) atoms2 =@@ -76,21 +80,21 @@     Refl -> case mappendAssocProof atom atoms1 atoms2 of       Refl -> MCons atom (mappend atoms1 atoms2) +-- | Create a list of a single matching atom. oneMAtom :: MAtom ctx xs -> MList ctx xs oneMAtom atom1 = MCons atom1 MNil +-- | Create a list of two matching atoms. twoMAtoms :: MAtom ctx xs -> MAtom (ctx :++: xs) ys -> MList ctx (xs :++: ys) twoMAtoms atom1 atom2 = MCons atom1 (MCons atom2 MNil) +-- | Create a list of three matching atoms. threeMAtoms :: MAtom ctx xs -> MAtom (ctx :++: xs) ys -> MAtom (ctx :++: xs :++: ys) zs -> MList ctx (xs :++: ys :++: zs) threeMAtoms atom1 atom2 atom3 =   case threeMConsAssocProof atom1 atom2 atom3 of     Refl -> MCons atom1 (MCons atom2 (MCons atom3 MNil)) -------- Heterogeneous list-----+-- | Heterogeneous list. data HList xs where   HNil :: HList '[]   HCons :: a -> HList as -> HList (a ': as)@@ -100,6 +104,7 @@   '[] :++: bs = bs   (a ': as) :++: bs = a ': (as :++: bs) +-- | Concatenate two heterogeneous lists. happend :: HList as -> HList bs -> HList (as :++: bs) happend HNil ys         = ys happend xs@(HCons x xs') ys = case hconsAssocProof x xs' ys of

@@ -14,21 +14,29 @@ import           Unsafe.Coerce import           Data.Type.Equality +-- | @matchAll@ takes a target, a matcher, and a list of match clauses.+-- @matchAll@ collects all the pattern-matching results and returns a list of the results evaluating the body expression for each pattern-matching result.+-- @matchAll@ traverses a search tree for pattern matching in breadth-first order. matchAll :: (Matcher m a) => a -> m -> [MatchClause a m b] -> [b] matchAll tgt m [] = [] matchAll tgt m ((MatchClause pat f):cs) =   let results = processMStatesAll [[MState HNil (MCons (MAtom pat m tgt) MNil)]] in   map f results ++ matchAll tgt m cs +-- | @match@ takes a target, a matcher, and a list of match clauses.+-- @match@ calculates only the first pattern-matching result and returns the results evaluating the body expression for the first pattern-matching result.+-- @match@ traverses a search tree for pattern matching in breadth-first order. match :: (Matcher m a) => a -> m -> [MatchClause a m b] -> b match tgt m cs = head $ matchAll tgt m cs +-- | @matchAllDFS@ is much similar to @matchAll@ but traverses a search tree for pattern matching in depth-first order. matchAllDFS :: (Matcher m a) => a -> m -> [MatchClause a m b] -> [b] matchAllDFS tgt m [] = [] matchAllDFS tgt m ((MatchClause pat f):cs) =   let results = processMStatesAllDFS [MState HNil (MCons (MAtom pat m tgt) MNil)] in   map f results ++ matchAllDFS tgt m cs +-- | @matchDFS@ is much similar to @match@ but traverses a search tree for pattern matching in depth-first order. matchDFS :: (Matcher m a) => a -> m -> [MatchClause a m b] -> b matchDFS tgt m cs = head $ matchAllDFS tgt m cs 

@@ -6,16 +6,16 @@ {-# LANGUAGE TypeOperators         #-}  module Control.Egison.Matcher (-  -- Something matcher+  -- * @Something@ matcher   Something(..),-  -- Eql and Integer matchers+  -- * @Eql@ and @Integer@ matchers   ValuePat(..),   Eql(..),   Integer(..),-  -- Pair matcher+  -- * @Pair@ matcher   PairPat(..),   Pair(..),-  -- Matchers for collections+  -- * Matchers for collections   CollectionPat(..),   List(..),   Multiset(..),@@ -28,54 +28,45 @@ import           Control.Egison.Match import           Control.Egison.QQ ------ Something matcher----+-- | Something built-in matcher. data Something = Something instance Matcher Something a ------ Eql and Integer matchers----+-- | Value patterns class ValuePat m a where   valuePat :: (Matcher m a, Eq a) => (HList ctx -> a) -> Pattern a m ctx '[] --- Eql matcher+-- | A matcher for data types that are instances of @Eq@. data Eql = Eql instance Matcher Eql a  instance Eq a => ValuePat Eql a where   valuePat f = Pattern (\ctx _ tgt -> [MNil | f ctx == tgt]) --- Integer matcher+-- | A matcher for integers. data Integer = Integer instance Integral a => Matcher Integer a  instance Integral a => ValuePat Integer a where   valuePat f = Pattern (\ctx _ tgt -> [MNil | f ctx == tgt]) -------- Pair matcher---- -data Pair m1 m2 = Pair m1 m2-instance (Matcher m1 a1, Matcher m2 a2) => Matcher (Pair m1 m2) (a1, a2)-+-- | A pattern constructor for pairs. class PairPat m a where   pair :: (Matcher m a , a ~ (b1, b2), m ~ (Pair m1 m2))        => Pattern b1 m1 ctx xs        -> Pattern b2 m2 (ctx :++: xs) ys        -> Pattern a m ctx (xs :++: ys) +-- | A matcher for a pair of data.+data Pair m1 m2 = Pair m1 m2+instance (Matcher m1 a1, Matcher m2 a2) => Matcher (Pair m1 m2) (a1, a2)+ instance (Matcher m1 a1, Matcher m2 a2) => PairPat (Pair m1 m2) (a1, a2) where   pair p1 p2 = Pattern (\_ (Pair m1 m2) (t1, t2) -> [twoMAtoms (MAtom p1 m1 t1) (MAtom p2 m2 t2)]) -------- Matchers for collections---- +-- | Patterns for collections. class CollectionPat m a where   nil  :: (Matcher m a) => Pattern a m ctx '[]   cons :: (Matcher m a, a ~ [a'], m ~ (f m'))@@ -87,7 +78,7 @@        -> Pattern a m (ctx :++: xs) ys        -> Pattern a m ctx (xs :++: ys) --- List matcher+-- | a matcher for a list. newtype List m = List m instance (Matcher m a) => Matcher (List m) [a] @@ -111,7 +102,7 @@ splits []     = [([], [])] splits (x:xs) = ([], x:xs) : [(x:ys, zs) | (ys, zs) <- splits xs] --- Multiset matcher+-- | a matcher for a multiset. newtype Multiset m = Multiset m instance (Matcher m a) => Matcher (Multiset m) [a] @@ -129,7 +120,7 @@                                                    (matchAll tgt (List m) [[mc| join $hs (cons $x $ts) => (x, hs ++ ts) |]]))   join p1 p2 = undefined --- Set matcher+-- | a matcher for a set. newtype Set m = Set m instance (Matcher m a) => Matcher (Set m) [a]