@@ -7,34 +7,48 @@ Everything to do with term indexing.
7
7
module Booster.Pattern.Index (
8
8
CellIndex (.. ),
9
9
TermIndex (.. ),
10
+ -- Flat lattice
11
+ (^<=^) ,
12
+ invert ,
13
+ -- compute index cover for rule selection
14
+ covering ,
15
+ -- indexing
10
16
compositeTermIndex ,
11
17
kCellTermIndex ,
12
18
termTopIndex ,
13
- coveringIndexes ,
19
+ -- helpers
14
20
hasNone ,
21
+ noFunctions ,
15
22
) where
16
23
17
24
import Control.Applicative (Alternative (.. ), asum )
18
25
import Control.DeepSeq (NFData )
26
+ import Data.ByteString.Char8 (ByteString , unpack )
19
27
import Data.Functor.Foldable (embed , para )
20
28
import Data.Maybe (fromMaybe )
21
29
import Data.Set (Set )
22
30
import Data.Set qualified as Set
23
31
import GHC.Generics (Generic )
32
+ import Prettyprinter (Doc , Pretty , pretty , sep )
24
33
25
34
import Booster.Pattern.Base
35
+ import Booster.Util (decodeLabel )
26
36
27
37
{- | Index data allowing for a quick lookup of potential axioms.
28
38
29
39
A @Term@ is indexed by inspecting the top term component of one or
30
40
more given cells. A @TermIndex@ is a list of @CellIndex@es.
31
41
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.
35
49
36
50
Rather 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).
38
52
This can then handle @AndTerm@ by indexing both arguments and
39
53
combining them.
40
54
@@ -47,52 +61,117 @@ newtype TermIndex = TermIndex [CellIndex]
47
61
deriving anyclass (NFData )
48
62
49
63
data 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
52
71
| Anything -- top element
53
- -- should we have | Value Sort ?? (see Term type)
54
72
deriving stock (Eq , Ord , Show , Generic )
55
73
deriving anyclass (NFData )
56
74
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).
58
111
59
112
This is useful for terms containing an 'AndTerm': Any term that
60
113
matches an 'AndTerm t1 t2' must match both 't1' and 't2', so 't1'
61
114
and 't2' must have "compatible" indexes for this to be possible.
62
115
-}
63
116
instance Semigroup CellIndex where
64
- None <> _ = None
65
- _ <> None = None
117
+ IdxNone <> _ = IdxNone
118
+ _ <> IdxNone = IdxNone
66
119
x <> Anything = x
67
120
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
71
124
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
73
128
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"
76
138
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
90
141
91
- {- | Check whether a @TermIndex@ has @None @ in any position (this
142
+ {- | Check whether a @TermIndex@ has @IdxNone @ in any position (this
92
143
means no match will be possible).
93
144
-}
94
145
hasNone :: 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
96
175
97
176
-- | Indexes a term by the heads of K sequences in given cells.
98
177
compositeTermIndex :: [SymbolName ] -> Term -> TermIndex
@@ -162,11 +241,25 @@ stripSortInjections = \case
162
241
termTopIndex :: Term -> TermIndex
163
242
termTopIndex = TermIndex . (: [] ) . cellTopIndex
164
243
244
+ -- | Cell top indexes form a lattice with a flat partial ordering
165
245
cellTopIndex :: Term -> CellIndex
166
246
cellTopIndex = \ 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
169
264
AndTerm t1 t2 ->
170
265
cellTopIndex t1 <> cellTopIndex t2
171
- _other ->
172
- Anything
0 commit comments