@@ -107,8 +107,8 @@ data InternalisedPredicate
107107 deriving stock (Eq , Show )
108108
109109data InternalisedPredicates = InternalisedPredicates
110- { boolPredicates :: Set Internal. Predicate
111- , ceilPredicates :: Set Internal. Ceil
110+ { boolPredicates :: [ Internal. Predicate]
111+ , ceilPredicates :: [ Internal. Ceil]
112112 , substitution :: Map Internal. Variable Internal. Term
113113 , unsupported :: [Syntax. KorePattern ]
114114 }
@@ -117,8 +117,8 @@ data InternalisedPredicates = InternalisedPredicates
117117instance FromModifiersT mods => Pretty (PrettyWithModifiers mods InternalisedPredicates ) where
118118 pretty (PrettyWithModifiers ps) =
119119 Pretty. vsep $
120- (" Bool predicates: " : map (pretty' @ mods ) ( Set. toList ps. boolPredicates) )
121- <> (" Ceil predicates: " : map (pretty' @ mods ) ( Set. toList ps. ceilPredicates) )
120+ (" Bool predicates: " : map (pretty' @ mods ) ps. boolPredicates)
121+ <> (" Ceil predicates: " : map (pretty' @ mods ) ps. ceilPredicates)
122122 <> ( " Substitution: "
123123 : map
124124 (\ (v, t) -> pretty' @ mods v Pretty. <+> " ->" Pretty. <+> pretty' @ mods t)
@@ -145,7 +145,14 @@ internalisePattern ::
145145 Maybe [Syntax. Id ] ->
146146 KoreDefinition ->
147147 Syntax. KorePattern ->
148- Except PatternError (Internal. Pattern , Map Internal. Variable Internal. Term , [Syntax. KorePattern ])
148+ Except
149+ PatternError
150+ ( Internal. Term
151+ , [Internal. Predicate ]
152+ , [Internal. Ceil ]
153+ , Map Internal. Variable Internal. Term
154+ , [Syntax. KorePattern ]
155+ )
149156internalisePattern allowAlias checkSubsorts sortVars definition p = do
150157 (terms, predicates) <- partitionM isTermM $ explodeAnd p
151158
@@ -157,11 +164,9 @@ internalisePattern allowAlias checkSubsorts sortVars definition p = do
157164 internalPs <-
158165 internalisePredicates allowAlias checkSubsorts sortVars definition predicates
159166 pure
160- ( Internal. Pattern
161- { term
162- , constraints = internalPs. boolPredicates
163- , ceilConditions = Set. toList internalPs. ceilPredicates
164- }
167+ ( term
168+ , internalPs. boolPredicates
169+ , internalPs. ceilPredicates
165170 , internalPs. substitution
166171 , internalPs. unsupported
167172 )
@@ -196,7 +201,7 @@ internalisePatternOrTopOrBottom ::
196201 Except
197202 PatternError
198203 ( PatternOrTopOrBottom
199- ([Internal. Variable ], ( Internal. Pattern , Map Internal. Variable Internal. Term , [Syntax. KorePattern ]) )
204+ ([Internal. Variable ], Internal. Pattern , Map Internal. Variable Internal. Term , [Syntax. KorePattern ])
200205 )
201206internalisePatternOrTopOrBottom allowAlias checkSubsorts sortVars definition existentials p = do
202207 let exploded = explodeAnd p
@@ -210,7 +215,15 @@ internalisePatternOrTopOrBottom allowAlias checkSubsorts sortVars definition exi
210215 variableSort <- lookupInternalSort sortVars definition. sorts p sort
211216 let variableName = textToBS var. getId
212217 pure $ Internal. Variable {variableSort, variableName}
213- IsPattern . (existentialVars,) <$> internalisePattern allowAlias checkSubsorts sortVars definition p
218+ (term, preds, ceilConditions, subst, unknown) <-
219+ internalisePattern allowAlias checkSubsorts sortVars definition p
220+ pure $
221+ IsPattern
222+ ( existentialVars
223+ , Internal. Pattern {term, constraints = Set. fromList preds, ceilConditions}
224+ , subst
225+ , unknown
226+ )
214227 where
215228 isTop = \ case
216229 [Syntax. KJTop {sort}] -> Just $ IsTop sort
@@ -234,9 +247,13 @@ internaliseTermOrPredicate allowAlias checkSubsorts sortVars definition syntaxPa
234247 internalisePredicates allowAlias checkSubsorts sortVars definition [syntaxPatt]
235248 )
236249 <|> ( withExcept (: [] ) $ do
237- (pat , substitution, unsupported) <-
250+ (term, constrs, ceilConditions , substitution, unsupported) <-
238251 internalisePattern allowAlias checkSubsorts sortVars definition syntaxPatt
239- pure $ TermAndPredicates pat substitution unsupported
252+ pure $
253+ TermAndPredicates
254+ Internal. Pattern {term, constraints = Set. fromList constrs, ceilConditions}
255+ substitution
256+ unsupported
240257 )
241258
242259lookupInternalSort ::
@@ -412,8 +429,8 @@ internalisePredicates allowAlias checkSubsorts sortVars definition ps = do
412429
413430 pure
414431 InternalisedPredicates
415- { boolPredicates = Set. fromList $ [p | BoolPred p <- internalised] <> moreEquations
416- , ceilPredicates = Set. fromList $ [p | CeilPred p <- internalised]
432+ { boolPredicates = [p | BoolPred p <- internalised] <> moreEquations
433+ , ceilPredicates = [p | CeilPred p <- internalised]
417434 , substitution
418435 , unsupported = [p | UnsupportedPred p <- internalised]
419436 }
@@ -682,6 +699,8 @@ data PatternError
682699 | UnknownSymbol Syntax. Id Syntax. KorePattern
683700 | MacroOrAliasSymbolNotAllowed Syntax. Id Syntax. KorePattern
684701 | SubstitutionNotAllowed
702+ | PredicateNotAllowed
703+ | CeilNotAllowed
685704 | IncorrectSymbolArity Syntax. KorePattern Syntax. Id Int Int
686705 deriving stock (Eq , Show )
687706
@@ -715,6 +734,8 @@ patternErrorToRpcError = \case
715734 MacroOrAliasSymbolNotAllowed sym p ->
716735 wrap (" Symbol '" <> Syntax. getId sym <> " ' is a macro/alias" ) p
717736 SubstitutionNotAllowed -> RpcError. ErrorOnly " Substitution predicates are not allowed here"
737+ PredicateNotAllowed -> RpcError. ErrorOnly " Predicates are not allowed here"
738+ CeilNotAllowed -> RpcError. ErrorOnly " Ceil predicates are not allowed here"
718739 IncorrectSymbolArity p s expected got ->
719740 wrap
720741 ( " Inconsistent pattern. Symbol '"
@@ -740,6 +761,8 @@ logPatternError = \case
740761 UnknownSymbol sym p -> withKorePatternContext p $ logMessage $ " Unknown symbol '" <> Syntax. getId sym <> " '"
741762 MacroOrAliasSymbolNotAllowed sym p -> withKorePatternContext p $ logMessage $ " Symbol '" <> Syntax. getId sym <> " ' is a macro/alias"
742763 SubstitutionNotAllowed -> logMessage (" Substitution predicates are not allowed here" :: Text )
764+ PredicateNotAllowed -> logMessage (" Predicates are not allowed here" :: Text )
765+ CeilNotAllowed -> logMessage (" Ceil predicates are not allowed here" :: Text )
743766 IncorrectSymbolArity p s expected got ->
744767 withKorePatternContext p $
745768 logMessage $
0 commit comments