@@ -7,34 +7,48 @@ Everything to do with term indexing.
77module Booster.Pattern.Index (
88 CellIndex (.. ),
99 TermIndex (.. ),
10+ -- Flat lattice
11+ (^<=^) ,
12+ invert ,
13+ -- compute index cover for rule selection
14+ covering ,
15+ -- indexing
1016 compositeTermIndex ,
1117 kCellTermIndex ,
1218 termTopIndex ,
13- coveringIndexes ,
19+ -- helpers
1420 hasNone ,
21+ noFunctions ,
1522) where
1623
1724import Control.Applicative (Alternative (.. ), asum )
1825import Control.DeepSeq (NFData )
26+ import Data.ByteString.Char8 (ByteString , unpack )
1927import Data.Functor.Foldable (embed , para )
2028import Data.Maybe (fromMaybe )
2129import Data.Set (Set )
2230import Data.Set qualified as Set
2331import GHC.Generics (Generic )
32+ import Prettyprinter (Doc , Pretty , pretty , sep )
2433
2534import Booster.Pattern.Base
35+ import Booster.Util (decodeLabel )
2636
2737{- | Index data allowing for a quick lookup of potential axioms.
2838
2939A @Term@ is indexed by inspecting the top term component of one or
3040more given cells. A @TermIndex@ is a list of @CellIndex@es.
3141
32- The @CellIndex@ of a cell containing a @SymbolApplication@ node is the
33- symbol at the top. Other terms that are not symbol applications have
34- index @Anything@.
42+ The @CellIndex@ of a cell reflects the top constructor of the term.
43+ For @SymbolApplication@s, constructors and functions are distinguished,
44+ for @DomainValue@s, the actual value (as a string) is part of the index.
45+ Internalised collections have special indexes, Variables have index @Anything@.
46+
47+ NB Indexes are _unsorted_. For instance, @IdxVal "42"@ is the index of
48+ both String "42" _and_ Integer 42.
3549
3650Rather than making the term indexing function partial, we introduce a
37- unique bottom element @None @ to the index type (to make it a lattice).
51+ unique bottom element @IdxNone @ to the index type (to make it a lattice).
3852This can then handle @AndTerm@ by indexing both arguments and
3953combining them.
4054
@@ -47,52 +61,117 @@ newtype TermIndex = TermIndex [CellIndex]
4761 deriving anyclass (NFData )
4862
4963data CellIndex
50- = None -- bottom element
51- | TopSymbol SymbolName
64+ = IdxNone -- bottom element
65+ | IdxCons SymbolName
66+ | IdxFun SymbolName
67+ | IdxVal ByteString
68+ | IdxMap
69+ | IdxList
70+ | IdxSet
5271 | Anything -- top element
53- -- should we have | Value Sort ?? (see Term type)
5472 deriving stock (Eq , Ord , Show , Generic )
5573 deriving anyclass (NFData )
5674
57- {- | Combines two indexes (an "infimum" function on the index lattice).
75+ {- | Index lattice class. This is mostly just a _flat lattice_ but also
76+ needs to support a special 'invert' method for the subject term index.
77+ -}
78+ class IndexLattice a where
79+ (^<=^) :: a -> a -> Bool
80+
81+ invert :: a -> a
82+
83+ {- | Partial less-or-equal for CellIndex (implies partial order)
84+
85+ Anything
86+ ____________/ | \_______________________________________...
87+ / / | | \ \
88+ IdxList ..IdxSet IdxVal "x"..IdxVal "y" IdxCons "A".. IdxFun "f"..
89+ \_________|__ | _______|____________|____________/____...
90+ \ | /
91+ IdxNone
92+ -}
93+ instance IndexLattice CellIndex where
94+ IdxNone ^<=^ _ = True
95+ a ^<=^ IdxNone = a == IdxNone
96+ _ ^<=^ Anything = True
97+ Anything ^<=^ a = a == Anything
98+ a ^<=^ b = a == b
99+
100+ invert IdxNone = Anything
101+ invert Anything = IdxNone
102+ invert a = a
103+
104+ -- | Partial less-or-equal for TermIndex (product lattice)
105+ instance IndexLattice TermIndex where
106+ TermIndex idxs1 ^<=^ TermIndex idxs2 = and $ zipWith (^<=^) idxs1 idxs2
107+
108+ invert (TermIndex idxs) = TermIndex (map invert idxs)
109+
110+ {- | Combines two indexes ("infimum" or "meet" function on the index lattice).
58111
59112 This is useful for terms containing an 'AndTerm': Any term that
60113 matches an 'AndTerm t1 t2' must match both 't1' and 't2', so 't1'
61114 and 't2' must have "compatible" indexes for this to be possible.
62115-}
63116instance Semigroup CellIndex where
64- None <> _ = None
65- _ <> None = None
117+ IdxNone <> _ = IdxNone
118+ _ <> IdxNone = IdxNone
66119 x <> Anything = x
67120 Anything <> x = x
68- s @ ( TopSymbol s1) <> TopSymbol s2
69- | s1 == s2 = s
70- | otherwise = None -- incompatible indexes
121+ idx1 <> idx2
122+ | idx1 == idx2 = idx1
123+ | otherwise = IdxNone
71124
72- {- | Compute all indexes that cover the given index, for rule lookup.
125+ -- | Pretty instances
126+ instance Pretty TermIndex where
127+ pretty (TermIndex ixs) = sep $ map pretty ixs
73128
74- An index B is said to "cover" another index A if all parts of B are
75- either equal to the respective parts of A, or 'Anything'.
129+ instance Pretty CellIndex where
130+ pretty IdxNone = " _|_"
131+ pretty Anything = " ***"
132+ pretty (IdxCons sym) = " C--" <> prettyLabel sym
133+ pretty (IdxFun sym) = " F--" <> prettyLabel sym
134+ pretty (IdxVal sym) = " V--" <> prettyLabel sym
135+ pretty IdxMap = " Map"
136+ pretty IdxList = " List"
137+ pretty IdxSet = " Set"
76138
77- When selecting candidate rules for a term, we must consider all
78- rules whose index has either the exact same @CellIndex@ or
79- @Anything@ at every position of their @TermIndex@.
80- -}
81- coveringIndexes :: TermIndex -> Set TermIndex
82- coveringIndexes (TermIndex ixs) =
83- Set. fromList . map TermIndex $ orAnything ixs
84- where
85- orAnything :: [CellIndex ] -> [[CellIndex ]]
86- orAnything [] = [[] ]
87- orAnything (i : is) =
88- let rest = orAnything is
89- in map (i : ) rest <> map (Anything : ) rest
139+ prettyLabel :: ByteString -> Doc a
140+ prettyLabel = either error (pretty . unpack) . decodeLabel
90141
91- {- | Check whether a @TermIndex@ has @None @ in any position (this
142+ {- | Check whether a @TermIndex@ has @IdxNone @ in any position (this
92143means no match will be possible).
93144-}
94145hasNone :: TermIndex -> Bool
95- hasNone (TermIndex ixs) = None `elem` ixs
146+ hasNone (TermIndex ixs) = IdxNone `elem` ixs
147+
148+ -- | turns IdxFun _ into Anything (for rewrite rule selection)
149+ noFunctions :: TermIndex -> TermIndex
150+ noFunctions (TermIndex ixs) = TermIndex (map funsAnything ixs)
151+ where
152+ funsAnything IdxFun {} = Anything
153+ funsAnything other = other
154+
155+ {- | Computes all indexes that "cover" the given index, for rule lookup.
156+
157+ An index B is said to "cover" an index A if all components of B are
158+ greater or equal to those of the respective component of A inverted.
159+
160+ * For components of A that are distinct from @Anything@, this means
161+ the component of B is equal to that of A or @Anything@.
162+ * For components of A that are @IdxNone@, the respective component of B
163+ _must_ be @Anything@. However, if A contains @IdxNone@ no match is
164+ possible anyway.
165+ * For components of A that are @Anything@, B can contain an
166+ arbitrary index (@IdxNone@ will again have no chance of a match,
167+ though).
168+
169+ When selecting candidate rules for a term, we must consider all
170+ rules whose index has either the exact same @CellIndex@ or
171+ @Anything@ at every position of their @TermIndex@.
172+ -}
173+ covering :: Set TermIndex -> TermIndex -> Set TermIndex
174+ covering prior ix = Set. filter (invert ix ^<=^ ) prior
96175
97176-- | Indexes a term by the heads of K sequences in given cells.
98177compositeTermIndex :: [SymbolName ] -> Term -> TermIndex
@@ -162,11 +241,25 @@ stripSortInjections = \case
162241termTopIndex :: Term -> TermIndex
163242termTopIndex = TermIndex . (: [] ) . cellTopIndex
164243
244+ -- | Cell top indexes form a lattice with a flat partial ordering
165245cellTopIndex :: Term -> CellIndex
166246cellTopIndex = \ case
167- SymbolApplication symbol _ _ ->
168- TopSymbol symbol. name
247+ ConsApplication symbol _ _ ->
248+ IdxCons symbol. name
249+ FunctionApplication symbol _ _ ->
250+ IdxFun symbol. name
251+ DomainValue _ v ->
252+ IdxVal v
253+ Var {} ->
254+ Anything
255+ KMap {} ->
256+ IdxMap
257+ KList {} ->
258+ IdxList
259+ KSet {} ->
260+ IdxSet
261+ -- look-through
262+ Injection _ _ t ->
263+ cellTopIndex t
169264 AndTerm t1 t2 ->
170265 cellTopIndex t1 <> cellTopIndex t2
171- _other ->
172- Anything
0 commit comments