| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Control.Egison.Core
Description
Definitions of data types for patterns, matchers, match clauses, matching states, and matching atoms.
Synopsis
- data Pattern a m ctx vs where
- Wildcard :: Matcher m a => Pattern a m ctx '[]
- PatVar :: Matcher m a => String -> Pattern a m ctx '[a]
- AndPat :: Matcher m a => Pattern a m ctx vs -> Pattern a m (ctx :++: vs) vs' -> Pattern a m ctx (vs :++: vs')
- OrPat :: Matcher m a => Pattern a m ctx vs -> Pattern a m ctx vs -> Pattern a m ctx vs
- NotPat :: Matcher m a => Pattern a m ctx '[] -> Pattern a m ctx '[]
- PredicatePat :: Matcher m a => (HList ctx -> a -> Bool) -> Pattern a m ctx '[]
- Pattern :: Matcher m a => (HList ctx -> m -> a -> [MList ctx vs]) -> Pattern a m ctx vs
- class Matcher m a
- data MatchClause a m b = Matcher m a => MatchClause (Pattern a m '[] vs) (HList vs -> b)
- data MState vs where
- data MAtom ctx vs = Matcher m a => MAtom (Pattern a m ctx vs) m a
- data MList ctx vs where
- mappend :: MList ctx xs -> MList (ctx :++: xs) ys -> MList ctx (xs :++: ys)
- oneMAtom :: MAtom ctx xs -> MList ctx xs
- twoMAtoms :: MAtom ctx xs -> MAtom (ctx :++: xs) ys -> MList ctx (xs :++: ys)
- threeMAtoms :: MAtom ctx xs -> MAtom (ctx :++: xs) ys -> MAtom ((ctx :++: xs) :++: ys) zs -> MList ctx ((xs :++: ys) :++: zs)
- data HList xs where
- happend :: HList as -> HList bs -> HList (as :++: bs)
- type family (as :: [*]) :++: (bs :: [*]) :: [*] where ...
Patterns
data Pattern a m ctx vs where Source #
A pattern for data of a type a for a matcher m.
ctx is an intermediate pattern-matching result that is 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.
Constructors
| Wildcard :: Matcher m a => Pattern a m ctx '[] | |
| PatVar :: Matcher m a => String -> Pattern a m ctx '[a] | |
| AndPat :: Matcher m a => Pattern a m ctx vs -> Pattern a m (ctx :++: vs) vs' -> Pattern a m ctx (vs :++: vs') | |
| OrPat :: Matcher m a => Pattern a m ctx vs -> Pattern a m ctx vs -> Pattern a m ctx vs | |
| NotPat :: Matcher m a => Pattern a m ctx '[] -> Pattern a m ctx '[] | |
| PredicatePat :: Matcher m a => (HList ctx -> a -> Bool) -> Pattern a m ctx '[] | |
| Pattern :: Matcher m a => (HList ctx -> m -> a -> [MList ctx vs]) -> Pattern a m ctx vs | 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. |
The Matcher class is used to declare that m is a matcher for data of a type a.
For example,
instance (Matcher m a) => Matcher (Multiset m) [a]
declares that "let m be a matcher for a, (Multiset m) is a matcher for [a]".
Instances
| Integral a => Matcher Integer a Source # | |
Defined in Control.Egison.Matcher | |
| Eq a => Matcher Eql a Source # | |
Defined in Control.Egison.Matcher | |
| Matcher Something a Source # | |
Defined in Control.Egison.Matcher | |
| Matcher m a => Matcher (Set m) [a] Source # | |
Defined in Control.Egison.Matcher | |
| Matcher m a => Matcher (Multiset m) [a] Source # | |
Defined in Control.Egison.Matcher | |
| Matcher m a => Matcher (List m) [a] Source # | |
Defined in Control.Egison.Matcher | |
| (Matcher m1 a1, Matcher m2 a2) => Matcher (Pair m1 m2) (a1, a2) Source # | |
Defined in Control.Egison.Matcher | |
data MatchClause a m b Source #
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.
The first argument of MatchClause is a pattern for a with a matcher m.
This pattern makes a binding whose type is vs.
The second argument of MatchClause is a function that takes a heterogeneous list containing vs and returns b.
vs is existentially quantified because generally each pattern of the list of match clauses in a pattern-matching expression makes different bindings.
Several samples of MatchClauses are found in Control.Egison.QQ.
The mc quasiquoter allows us to describe a match clause in user-friendly syntax.
Constructors
| Matcher m a => MatchClause (Pattern a m '[] vs) (HList vs -> b) |
Matching states and matching atoms
A matching state.
A matching state consists of an intermediate pattern-matching result and a stack of matching atoms.
vs is a list of types bound to the pattern variables in the pattern after processing MState.
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.
The types of a target a and a matcher m are existentially quantified each matching atom in a stack of matching atoms contains a pattern, matcher, and target for a different type.
data MList ctx vs where Source #
A list of matching atoms. It is used to represent a stack of matching atoms in a matching state.
mappend :: MList ctx xs -> MList (ctx :++: xs) ys -> MList ctx (xs :++: ys) Source #
Concatenate two lists of matching atoms.
twoMAtoms :: MAtom ctx xs -> MAtom (ctx :++: xs) ys -> MList ctx (xs :++: ys) Source #
Create a list of two matching atoms.
threeMAtoms :: MAtom ctx xs -> MAtom (ctx :++: xs) ys -> MAtom ((ctx :++: xs) :++: ys) zs -> MList ctx ((xs :++: ys) :++: zs) Source #
Create a list of three matching atoms.
Heterogeneous lists
Heterogeneous lists.